Цель курсовой работы заключалась в составление оптимального плана транспортной задачи распределительным методом.

Все цели которые были поставлены в курсовом проекте были выполнены.

Была построена математическая модель транспортной задачи, после чего разработан алгоритм решения. На основе выше перечисленных целей была создана программа для решения транспортной задачи распределительным методом. В итоге были решены множество задач программой, ответ которой совпадал с заранее подготовленным решением.

Таким образом, цель курсового проекта была полностью достигнута, а сам курсовой проект выполнен.

Список использованных источников

1. http://math. semestr.ru/transp/modellp. php

2. http://math. semestr.ru/transp/index. php

3. http://works. tarefer.ru/100/100068/index.html

4. http://forum. ishodniki.ru/index. php? topic=12012.5; wap2

5. Агальцов В.П., Математические методы в программировании: учебник / В.П. Агальцов, И.В. Вальдайская. - М. ИД "Форум": ИНФА-М, 206. - 224с.

6. Стандарт предприятия (колледжа). Требования по выполнению и оформлению дипломных и курсовых проектов (работ). СТП-УГК-5. ФГОУ СПО УГК им.И. И. Ползунова, 2005г. - 42с.

Приложение А

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, ComCtrls, Buttons, Spin;

type

arr = array [1.100,1.100] of integer;

TForm1 = class (TForm)

StringGrid1: TStringGrid;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

ComboBox1: TComboBox;

Button1: TButton;

SpinEdit1: TSpinEdit;

SpinEdit2: TSpinEdit;

Button2: TButton;

procedure Button1Click (Sender: TObject);

procedure ComboBox1KeyPress (Sender: TObject; var Key: Char);

procedure FormCreate (Sender: TObject);

procedure StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure StringGrid1KeyPress (Sender: TObject; var Key: Char);

procedure StringGrid1GetEditText (Sender: TObject; ACol, ARow: Integer;

var Value: String);

procedure SpinEdit1Change (Sender: TObject);

procedure SpinEdit2Change (Sender: TObject);

procedure SpinEdit1KeyPress (Sender: TObject; var Key: Char);

procedure SpinEdit2KeyPress (Sender: TObject; var Key: Char);

procedure Button2Click (Sender: TObject);

private

procedure opor_plan (ColCount,RowCount: integer); // опорный план

procedure raspred_metod (mas12: arr); // органазация распределительного метода

function sum_pot (StringGrid: TStringGrid): integer; // сумма потребителей

function sum_proiz (StringGrid: TStringGrid): integer; // сумма производителей

procedure FindPath (i,j: integer); // нахождение пути

function LookHorizontaly (u, v, u1, v1: integer): boolean; // проверяем есть ли в строке ячейка которую можно взять в контур

procedure AddElement (u,v: integer); // добавляем индексы элемента в путь контура

function LookVerticaly (u, v, u1, v1: integer): boolean; // проверяем есть ли в столбце ячейка которую можно взять в контур

procedure proced (); // процедура для нахождение отрицательного значения по сумме контура

procedure pereraspred (i: integer); // осуществляется построение следующего опорного плана

{ Private declarations }

public

{ Public declarations }

end;

const n=100;

var

Form1: TForm1;

koef,koef2,mas: arr; // массивы коэффициентов размерностью 100x100

nVeryLargeNumber: integer; // большое чилсо

aPath: array of integer; // массив пути

contur: array of array of integer; // массив контура

k,qwe,kp: integer;

s: string;

implementation

uses Unit2;

{$R *. dfm}

procedure TForm1. Button1Click (Sender: TObject);

var

i,j,rc,cc: integer;

k: bool;

begin

k: =false;

rc: =StringGrid1. RowCount-1; // строки

cc: =StringGrid1. ColCount-1; // столбцы

// проверка таблицы стоимости

for i: =1 to cc do

for j: =1 to rc do

if (StringGrid1. Cells [i,j] ='') or (StringGrid1. Cells [i,j] ='0') then k: =true;

// проверка на сбалансированность программы

if k<>true then

begin

if sum_pot (StringGrid1) =sum_proiz (StringGrid1) then

opor_plan (StringGrid1. ColCount,StringGrid1. RowCount)

else ShowMessage ('Задача не сбалансирована, приведите ее к сбалансированному виду');

end

else ShowMessage (Заполните пустые клетки или уберите нули);

end;

procedure TForm1.comboBox1KeyPress (Sender: TObject; var Key: Char);

begin

Key: =#0;

end;

procedure TForm1. FormCreate (Sender: TObject);

var

i: integer;

begin

nVeryLargeNumber: =999999;

StringGrid1. Cells [0,0]: ='Матрица';

StringGrid1. ColCount: =SpinEdit1. Value+2; // задаем количество столбцов = 2

StringGrid1. RowCount: =SpinEdit2. Value+2; // задаем количество строк = 2

for i: =1 to StringGrid1. ColCount-2 do

StringGrid1. Cells [i,0]: ='A'+IntToStr (i);

for i: =1 to StringGrid1. RowCount-2 do

StringGrid1. Cells [0, i]: ='B'+IntToStr (i);

StringGrid1. Cells [StringGrid1. ColCount-1,0]: ='Производители';

StringGrid1. Cells [0,StringGrid1. RowCount-1]: ='Потребители';

StringGrid1. Cells [StringGrid1. ColCount-1,StringGrid1. RowCount-1]: ='A';

end;

procedure TForm1. AddElement (u, v: integer); // добавляем индексы элемента в путь контура

begin

qwe: =kp+1;

aPath [qwe]: =u;

kp: =qwe+1;

aPath [kp]: =v;

end;

procedure TForm1. FindPath (i, j: integer); // нахождение пути

begin

kp: =-1;

qwe: =0;

AddElement (i,j);

if not LookHorizontaly (i, j, i, j) then

ShowMessage ('Невозможно найти контур для: '+IntToStr (i) +' '+IntToStr (j));

end;

function TForm1. LookHorizontaly (u, v, u1, v1: integer): boolean; // проверяем // есть ли в строке ячейка которую можно взять в контур

var

i,cc: integer;

begin

result: =false;

cc: =StringGrid1. colCount;

for i: =0 to cc do

if (i<>v) and (mas [u, i] <>0) then

begin

if i=v1 then

begin

AddElement (u, i); // добавление элементов

result: =true; // возвращаем true

end;

if LookVerticaly (u, i, u1, v1) then

begin

AddElement (u, i);

result: =True;

end;

end;

end;

function TForm1. LookVerticaly (u, v, u1, v1: integer): boolean; // проверяем // есть ли в стобце ячейка которую можно взять в контур

var

i,rc: integer;

begin

result: =false;

rc: =StringGrid1. rowCount;

for i: =0 to rc do

if (i<>u) and (mas [i,v] <>0) then

if LookHorizontaly (i, v, u1, v1) then

begin

AddElement (i,v);

result: =True;

end;

end;

procedure TForm1. opor_plan (ColCount, RowCount: integer); // опорный план

var

o,l, q, i, j, sum, rc, cc,min,k,p,x: integer;

need, fund: array [1. n] of integer; // массивы потребителей и производителей

mas123: arr;

begin

k: =0;

p: =0;

rc: =StringGrid1. RowCount-2; // строки

cc: =StringGrid1. ColCount-2; // стобцы

for i: =1 to rc do

for j: =1 to cc do

begin

koef [i,j]: =StrToIntDef (StringGrid1. Cells [j, i],0); // коэффициенты

koef2 [i,j]: =StrToIntDef (StringGrid1. Cells [j, i],0); // копия коэффициентов

mas123 [i,j]: =0; // обнуляем массив

end;

for i: =1 to cc do

need [i]: =StrToIntDef (StringGrid1. Cells [i,rc+1],0); // коэффициенты при "потребитель"

for i: =1 to rc do

fund [i]: =StrToIntDef (StringGrid1. Cells [cc+1, i],0); // коэффициенты при "производитель"

if (ComboBox1. Text='Минимального элемента') then

begin

while (min<>999999) do

begin

min: =999999;

for i: =1 to rc do

for j: =1 to cc do

begin

if (koef2 [i,j] <>0) and (koef2 [i,j] < min) then

begin

min: =koef2 [i,j]; // min элемент = koef2 [i,j]

k: =i; // первый индекс минимального элемента

p: =j; // второй индекс минимального элемента

end;

end;

koef2 [k,p]: =0; // в массиве коэффициенты минимальному элементу присваиваем 0 чтоб программа не брала его снова

if (fund [k] <> 0) and (need [p] <> 0) and (min<>999999) then

if fund [k] >= need [p] then // количество производителей >= количества потребителей

begin

mas123 [k,p]: =need [p];

fund [k]: =fund [k] - need [p];

need [p]: =0;

for i: =k to rc do

for j: =p to p do

begin

koef2 [i,j]: =0;

if fund [k] =need [p] then

for o: =k to k do

for l: =p to cc do

koef2 [o,l]: =0;

end;

end

else // количество производителей < количества потребителей

if min<>999999 then

begin

mas123 [k,p]: =fund [k];

need [p]: =need [p] - fund [k];

fund [k]: =0;

for i: =k to k do

for j: =p to cc do

koef2 [i,j]: =0;

end

else mas123 [k,p]: =0;

end;

end

else

begin

for i: =1 to rc do

for j: =1 to cc do

if (fund [i] <> 0) and (need [j] <> 0) then

if fund [i] >= need [j] then

begin

mas123 [i,j]: =need [j];

fund [i]: =fund [i] - need [j];

need [j]: =0;

end

else

begin

mas123 [i,j]: =fund [i];

need [j]: =need [j] - fund [i];

fund [i]: =0;

end

else mas123 [i,j]: =0;

end;

sum: =0;

Form2. StringGrid1. ColCount: =cc+2;

Form2. StringGrid1. RowCount: =rc+2;

Form2. StringGrid2. ColCount: =cc+2;

Form2. StringGrid2. RowCount: =rc+2;

for i: =1 to rc do

for j: =1 to cc do

begin

if mas123 [i,j] =0 then Form2. StringGrid1. Cells [j, i]: =''

else Form2. StringGrid1. Cells [j, i]: =IntToStr (mas123 [i,j]);

sum: =sum+mas123 [i,j] *koef [i,j];

end;

Form2. Edit1. Text: =IntToStr (sum); // выводим значение целевой функции в Edit

raspred_metod (mas123);

form2. Show;

end;

procedure TForm1. pereraspred (i: integer); // осуществляется построение следующего опорного плана

var

q,e,w,rc,cc,min: integer;

mas2: arr;

begin

rc: =Form2. StringGrid1. RowCount-2;

cc: =Form2. StringGrid1. ColCount-2;

for q: =1 to rc do

for w: =1 to cc do

mas2 [q,w]: =mas [q,w]; // копия опорного плана

// *****достаем адреса ячеек, которые были записаны при составлении контура**

for q: =0 to k-1 do

begin

w: =0;

e: =2;

while w<=rc*cc*2-3 do

begin

if (q<=k-1) and (contur [i,w] <>0) and (contur [i,w+1] <>0) then

if e mod 2<>0 then

mas2 [contur [i,w],contur [i,w+1]]: =mas [contur [i,w],contur [i,w+1]] * (-1)

else mas2 [contur [i,w],contur [i,w+1]]: =mas [contur [i,w],contur [i,w+1]];

w: =w+2;

e: =e+1;

end;

end;

w: =0;

min: =99999;

while w<=rc*cc*2-3 do

begin

if (contur [i,w] <>0) and (contur [i,w+1] <>0) then

if (abs (mas2 [contur [i,w],contur [i,w+1]]) <>mas2 [contur [i,w],contur [i,w+1]]) and (abs (min) >abs (mas2 [contur [i,w],contur [i,w+1]])) then

min: =mas2 [contur [i,w],contur [i,w+1]];

w: =w+2;

end;

w: =0;

while w<=rc*cc*2-3 do

begin

if (contur [i,w] <>0) and (contur [i,w+1] <>0) then

mas2 [contur [i,w],contur [i,w+1]]: =abs (mas2 [contur [i,w],contur [i,w+1]] - min);

w: =w+2;

end;

for q: =0 to Length (contur) - 1 do

for w: =0 to rc*cc*2-1 do

contur [q,w]: =0; // онуляем контур

raspred_metod (mas2);

end;

procedure TForm1. proced; // процедура для нахождения отрицательного значения по сумме контура

var

i,j,max,nom_max,rc,cc,sum1: integer;

massiv: array of integer;

flag: boolean;

begin

flag: =false;

rc: =Form2. StringGrid1. RowCount-2;

cc: =Form2. StringGrid1. ColCount-2;

SetLength (massiv,k);

j: =-1;

for i: =0 to k-1 do

begin

j: =j+1;

if abs (contur [i,rc*cc*2-1]) <>contur [i,rc*cc*2-1] then

begin

flag: =true;

massiv [j]: =i; // номер контура

end;

end;

if flag=false then // если flag=false тогда программа прекращает расчет и выводит оптимальный план и значение ЦФ

begin

sum1: =0;

for i: =1 to rc do

for j: =1 to cc do

begin

if mas [i,j] =0 then Form2. StringGrid2. Cells [j, i]: =''

else Form2. StringGrid2. Cells [j, i]: =IntToStr (mas [i,j]);

sum1: =sum1+mas [i,j] *koef [i,j];

end;

Form2. Edit2. Text: =IntToStr (sum1);

end

else

begin

max: =0;

nom_max: =0;

for i: =0 to k-1 do

begin

if massiv [i] <>0 then

if abs (max) <abs (contur [massiv [i],rc*cc*2-1]) then

begin

nom_max: =massiv [i]; // номер максимального по модулю контура с нуля

max: =contur [massiv [i],rc*cc*2-1];

end;

end;

pereraspred (nom_max)

end;

end;

procedure TForm1. raspred_metod (mas12: arr);

var

i,j,q,w,rc,cc: integer; // переменные для массива

begin

rc: =Form2. StringGrid1. RowCount-2;

cc: =Form2. StringGrid1. ColCount-2;

for i: =1 to rc do

for j: =1 to cc do

mas [i,j]: =mas12 [i,j];

for i: =1 to rc do

for j: =1 to cc do

begin

if mas [i,j] =0 then

begin

k: =k+1;

SetLength (contur,k,rc*cc*2);

SetLength (aPath,rc*cc*2);

for q: =0 to Length (aPath) - 1 do aPath [q]: =0;

FindPath (i,j); // находим контур

// Form2. Memo1. Lines. Add ('Контур '+ IntToStr (i) +' '+ IntToStr (j));

// Form2. Memo1. Lines. Add ('Ячейки: ');

for q: =k-1 to k-1 do

begin

s: ='';

for w: =0 to rc*cc*2-1 do

if aPath [w] <>0 then

begin

contur [q,w]: = aPath [w];

s: =s+IntTostr (contur [q,w]) +' ';

end;

// Form2. Memo1. Lines. Add (s);

end;

end;

end;

i: =-1;

while i<=k-1 do

begin

i: =i+1;

j: =0;

q: =2;

while j<=rc*cc*2-3 do

begin

if (i<=k-1) and (contur [i,j] <>0) and (contur [i,j+1] <>0) then

begin

if q mod 2<>0 then koef2 [contur [i,j],contur [i,j+1]]: =koef [contur [i,j],contur [i,j+1]] * (-1)

else koef2 [contur [i,j],contur [i,j+1]]: =koef [contur [i,j],contur [i,j+1]];

contur [i,rc*cc*2-1]: =contur [i,rc*cc*2-1] +koef2 [contur [i,j],contur [i,j+1]];

end;

j: =j+2;

q: =q+1;

end;

end;

proced ();

end;

function TForm1. sum_pot (StringGrid: TStringGrid): integer;

var

i,j: integer;

begin

result: =0;

for i: =StringGrid. ColCount-1 to StringGrid. ColCount-1 do

for j: =1 to StringGrid1. RowCount-1 do

result: =result+StrToIntDef (StringGrid. Cells [i,j],0);

end;

function TForm1. sum_proiz (StringGrid: TStringGrid): integer;

var

i,j: integer;

begin

result: =0;

for i: =1 to StringGrid. ColCount-1 do

for j: =StringGrid1. RowCount-1 to StringGrid1. RowCount-1 do

result: =result+StrToIntDef (StringGrid. Cells [i,j],0);

end;

procedure TForm1. StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

// окраска последнего столбца и последней строки StringGrid1 в оранжевый цвет

if Arow=StringGrid1. RowCount-1 then

begin

StringGrid1. Canvas. Brush. Color: =clHighlight; // цвет

StringGrid1. Canvas. FillRect (Rect); // Закрашиваем задний фон

StringGrid1. Canvas. TextOut (Rect. Left,Rect. Top,StringGrid1. Cells [Acol,Arow]); // закрашиваем текст, и выравнивание текста

end;

if ACol=StringGrid1. ColCount-1 then

begin

StringGrid1. Canvas. Brush. Color: =clHighlight;

StringGrid1. Canvas. FillRect (Rect);

StringGrid1. Canvas. TextOut (Rect. Left,Rect. Top,StringGrid1. Cells [Acol,Arow]);

end;

end;

procedure TForm1. StringGrid1KeyPress (Sender: TObject; var Key: Char);

begin

if ( (not (key in ['0'. '9'])) and (key<>#8)) then key: = #0;

if (StringGRid1. Col=StringGrid1. ColCount-1) and (StringGRid1. Row=StringGrid1. RowCount-1) then

key: =#0;

end;

procedure TForm1. StringGrid1GetEditText (Sender: TObject; ACol,

ARow: Integer; var Value: String);

var

h: HWND; // указатель на дескриптор окна

begin // handle это индефикатор объекта 'указатель'

h: = GetTopWindow ( (Sender as TStringGrid). Handle); // h присваиваем handle компонента stringgrid

if h <> 0 then

FindControl (h). Perform (EM_SETLIMITTEXT, 5, 0); // находим handle и устанавливаем max количество символов 5

end;

procedure TForm1. SpinEdit1Change (Sender: TObject);

var

i,j,rc,cc: integer;

begin

rc: =StringGrid1. RowCount; // строки

cc: =StringGrid1. ColCount; // столбцы

for i: =1 to cc do

for j: =1 to rc do

StringGrid1. Cells [i,j]: =''; // очищаем таблицу

StringGrid1. ColCount: =SpinEdit1. Value+2; // увеличиваем количество столбцов

StringGrid1. Cells [StringGrid1. ColCount-2,0]: ='A'+IntToStr (StringGrid1. ColCount-2); // назначаем имя столбцу

StringGrid1. Cells [StringGrid1. ColCount-1,0]: ='Производители'; // назначаем имя последнего столбца

StringGrid1. Cells [StringGrid1. ColCount-1,StringGrid1. RowCount-1]: ='A'; // назначаем имя таблицы

end;

procedure TForm1. SpinEdit2Change (Sender: TObject);

var

i,j,rc,cc: integer;

begin

rc: =StringGrid1. RowCount; // строки

cc: =StringGrid1. ColCount; // столбцы

for i: =1 to cc-1 do

for j: =1 to rc do

StringGrid1. Cells [i,j]: =''; // очищаем таблицу

StringGrid1. RowCount: =SpinEdit2. Value+2; // увеличиваем количество строк

StringGrid1. Cells [0,StringGrid1. RowCount-2]: ='B'+IntToStr (StringGrid1. RowCount-2); // назначаем имя строки

StringGrid1. Cells [0,StringGrid1. RowCount-1]: ='Потребители'; // назначаем имя последней строки

StringGrid1. Cells [StringGrid1. ColCount-1,StringGrid1. RowCount-1]: ='A'; // назначаем имя таблицы

end;

procedure TForm1. SpinEdit1KeyPress (Sender: TObject; var Key: Char);

begin

Key: =#0;

end;

procedure TForm1. SpinEdit2KeyPress (Sender: TObject; var Key: Char);

begin

Key: =#0;

end;

procedure TForm1. Button2Click (Sender: TObject);

begin

ShowMessage ('Автором этой программы являеться студент группы ПО-305'+ #13#10+ 'УГК имени И.И. Ползунова-- - Ищенко Евгений');

end;

end.

Размещено на Allbest.ru