Метод Фогеля приводит к лучшему начальному решению, чем два других метода. Однако он сложен для реализации на ЭВМ, так включает в себя множественные проверки, а также метод наименьшего расстояния. Несмотря на то, что метод наименьших расстояний дает лучшее начальное решение, чем метод «северо-западного» угла, он также сложен из-за большего числа различных проверок и постоянного определения минимума. Метод северо-западного угла наиболее прост, так базисное решение получается путем последовательного перехода по столбцам и строкам. Кроме этого стоит учитывать, что алгоритм выбора начального базисного решения не влияет на алгоритм поиска оптимального решения, то есть в любом случае дальнейшее решение задачи происходит по одной и той же схеме. Исходя из этого, при программной реализации задачи для поиска начального решения был выбран метод «северо-западного» угла. Даже если при этом потребуется большее количество итераций для поиска оптимального решения, более выгодно использовать этот метод, так как в этом случае возрастает точность решения, при этом структура программы будет заметно проще.
2.3 Нахождение оптимального решения задачиТак как не известно: оптимален ли полученный опорный план или нет, то стоит провести оценки базисных и небазисных переменных. Для этого воспользуемся методом потенциалов.Если условия не выполняются то, для включения в базис выбирается небазисная переменная, имеющая самое большое положительное значение. Для нахождения выводимой переменной строится замкнутый цикл. Цикл начинается и заканчивается выбранной небазисной переменной. Он состоит из последовательности вертикальных и горизонтальных отрезков, концами которых должны быть небазисные переменные. Построение данного цикла необходимо для того, чтобы после ввода новой переменной сбалансировать значения базисных переменных.
Не существенно, в каком направлении происходит обход цикла. Для каждого базисного переменного и соответствующей небазисной переменной можно построить только один цикл. После построения цикла вводимой небазисной переменной ставится в соответствие знака «+», далее базисным переменным, находящимся в узлах цикла ставятся поочередно знаки «-» и «+». Выводимой переменной считается базисная переменная, имеющая минимальное значение на местах со знаком «-». Далее к базисным переменным, находящимся на местах со знаком «+» прибавляется это значение, из переменных со знаком «-» – вычитается. Вводимой переменной присваивается найденное минимальное значение. После снова производятся оценки базисных и небазисных переменных и устанавливается, выполнены ли условия оптимальности. 3 ПРАКТИЧЕСКАЯ РЕАЛИЗАЦИЯРассмотрим основные алгоритм решения задачи. Он состоит из следующего:· нахождение начального базисного решения,· из число небазисных переменных выделяем переменную вводимую в базис, проверяем условия оптимальности, если они удовлетворены то заканчиваем расчет, если нет – переходим к следующему шагу,· из числа базисных переменных выделяем выводимую из базиса, находим новое базисное решение и возвращаемся ко второму шагу. который представлен в данной курсовой работе как тестовый пример.
Данные приведены в таблице 1.
Таблица 1. Исходные данные
Шаг 1. Находим начальное допустимое решение. Как уже сказано выше в данной курсовой работе для отыскания начального решения будем применять процедуру северо-западного угла (табл. 2).
Таблица 2.
Шаг 2. Выделить из числа небазисных переменных переменную, которую введем в базис.
Таблица 3. Построение цикла
Далее переходим к «шагу 3».
Шаг 3. Выбираем выводимую из базиса переменную из числа переменных текущего базиса. Затем находим новое базисное решение и вернутся к «шагу 2».
Таблица 4. Новое базисное решение
Таблица 5. Новое базисное решение
Данное решение будет оптимальным.
Оптимальное решение будет формулироваться следующим образом: общие расходы составят 4450 у.е., а маршруты будут таковы:
3-ая фабрика поставила товар в 1-й 3-й 4-й склады (3-й маршрут).
Алгоритм решения задачи можно представить в виде блок-схемы представленной в приложении А.1.
Листинг программы представлен в приложении Б.
4 РУКОВОДСТВО ПОЛЬЗОВАТЕЛЯ Для входа в программу необходимо запустить файл Transport.exe. После чего на экране появится главное окно программы, изображенное на рисунке 1.
Рисунок 2 – Работа программы.Для работы с программой необходимы минимальные аппаратные требования:
1) разрешение экрана − 800*600;
2) цветопередача − 16 бит;
4) память − 12 Mb;
6) PentiumII 400 MHz;
7) клавиатура;
8) мышь;
9) MicrosoftWindows 98 и выше;
ЗАКЛЮЧЕНИЕВ процессе работы были рассмотрены и изучены такие понятия как транспортная задача, основные методы решения транспортных задач, а так же был произведен расчет тестового примера. Для оптимизации расчетов и для уменьшении погрешностей вычислений был создан программный модуль в программной среде Delphi 7 под названием Transport.exe, который может использоваться как совместно с другими модулями, так и быть самостоятельным программным продуктом. БИБЛИОГРАФИЧЕСКИЙ СПИСОК1. Ашманов С.А. Линейное программирование/ С.А Ашманов – М.: Наука. Главная редакция физико-математической литературы, 1981. - 340 с.
2. Вентцтель Е.С. Исследование операций. Задачи, примеры, методология: Учеб. пособие для студентов ВТУЗОВ – М. Высш. шк., 2001 – 208 с.
3. Бобровский С. Delphi 7/ С. Бобровский – СПб.: Питер, 2006. –736 с.
4. Исследование операций. /Под ред. Дж.Моудера и С.Элмаграби/, - М.: Мир, 1981.
5. Эддоус М., Стэнефильд Р. Методы принятия решений / Пер. с англ. Под ред. член-корр. РАН И.И. Елисеевой. – М.: Аудит. ЮНИТИ, 1997. – 590 с.
ПРИЛОЖЕНИЕ А
Блок-схема реализованного алгоритма
Рис А.1 – Блок-схема реализованного алгоритмаПРИЛОЖЕНИЕ БЛистинг программы «Transport»unit intr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, ExtCtrls, StdCtrls, Buttons, Db, DBTables;
type
TForm1 = class(TForm)
tab1: TStringGrid;
Panel1: TPanel;
prdl: TEdit;
spr: TEdit;
spros: TStringGrid;
predl: TStringGrid;
Label1: TLabel;
Label2: TLabel;
Button2: TButton;
Button3: TButton;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label8: TLabel;
Memo1: TMemo;
Button1: TButton;
BitBtn1: TBitBtn;
Label7: TLabel;
Label9: TLabel;
Bevel1: TBevel;
procedure BitBtn1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
function read_data(): bool;
procedure balans();
procedure First_resh();
procedure find_uv();
procedure xnbmax(var max:real;var xi,yi:integer);
procedure print_tabl();
end;
var
Form1: TForm1;
implementation
uses task, dec;
{$R *.DFM}
var
c: array [1..100, 1..100] of real;
ch: array [1..6] of char;
spl, dmd: array [1..100] of real;
u,v: array [1..100] of real;
sspl,sdmd:real;
cycle,x: array [1..100, 1..100] of string;
xnb: array [1..100, 1..100] of real;
rw1,bn,ed,t,it,jt,it0,jt0,cl,rw:integer;
way:string;
ways: array [1..100] of string;
procedure search(q:string);
var i,j:integer;
begin
j:=jt; i:=it;
if q='up' then
for i:=1 to it-1 do
if not(x[i,j]='------------') then begin way:='up'; it:=i; break;end;
if q='right' then
for j:=cl downto jt+1 do
if not(x[i,j]='------------') then begin way:='right'; jt:=j; break;end;
if q='down' then
for i:=rw downto it+1 do
if not(x[i,j]='------------') then begin way:='down'; it:=i; break;end;
if q='left' then
for j:=1 to jt-1 do
if not(x[i,j]='------------') then begin way:='left'; jt:=j; break;end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
z,ind,i,j: integer;
ci,ri: byte;
s: string;
cd:integer;
bl,bln: boolean;
min,max,tmp,r:real;
zikl:integer;
uzli: array [1..100,1..2] of integer;
begin
if(not read_data()) then exit;
balans();
First_resh();
repeat
find_uv();
it:=1; jt:=1;
xnbmax(max,it,jt);
it0:=it; jt0:=jt;
if max<=0 then break;
x[it,jt]:='X';
it:=-1; jt:=-1;
for i:=1 to 4 do begin
way:='non';
it:=it0;jt:=jt0;
if(i=1) then search('up');
if(i=2) then search('down');
if(i=3) then search('left');
if(i=4) then search('right');
if(way='non') then continue;
zikl:=1;
ways[1]:='first';
uzli[1][1]:=it;
uzli[1][2]:=jt;
repeat
it:=uzli[zikl][1]; jt:=uzli[zikl][2];
s:=way;
if(ways[zikl]='first') then begin
if((way='up')or(way='down')) then begin way:='none'; search('left'); end
else begin way:='none'; search('up'); end;
if(way='none') then begin ways[zikl]:='second'; way:=s; end
else begin
ways[zikl]:='second';
zikl:=zikl+1;
uzli[zikl][1]:=it;
uzli[zikl][2]:=jt;
ways[zikl]:='first';
end;
end;
if(ways[zikl]='second') then begin
if((way='up')or(way='down')) then begin way:='none'; search('right'); end
else begin way:='none'; search('down'); end;
if(way='none') then ways[zikl]:='end'
else begin
ways[zikl]:='end';
zikl:=zikl+1;
uzli[zikl][1]:=it;
uzli[zikl][2]:=jt;
ways[zikl]:='first';
end;
end;
if(ways[zikl]='end') then begin
if((s='up')or(s='down')) then way:='right'
else way:='down';
if(zikl=1) then break
else zikl:=zikl-1;
end;
until (it=it0) and (jt=jt0);
if((it=it0)and(jt=jt0)) then break;
end;
min:=32000;
if(way='non') then min:=0
else
for i:=1 to zikl-1 do
if((i mod 2)=1) then begin
tmp:=strtofloat(x[uzli[i][1],uzli[i][2]]);
if(tmp<min) then min:=tmp;
end;
x[it0][jt0]:=floattostr(min);
bln:=false;
if(way<>'non') then
for i:=1 to zikl-1 do begin
tmp:=strtofloat(x[uzli[i][1],uzli[i][2]]);
if((i mod 2)=0) then begin tmp:=tmp+min; cycle[uzli[i][1],uzli[i][2]]:='+'; end
else begin tmp:=tmp-min; cycle[uzli[i][1],uzli[i][2]]:='-'; end;
x[uzli[i][1],uzli[i][2]]:=floattostr(tmp);
if(((i mod 2)=1)and(tmp=0)and(not bln)) then begin
x[uzli[i][1],uzli[i][2]]:='------------';
bln:=true;
end
end;
until false;
form3.Visible:=true;
print_tabl();
for i:=1 to rw1 do begin
s:=inttostr(i)+'-ая фабрика поставила товар в '; tmp:=0;
for j:=1 to cl do
if not (x[i,j]='------------') then begin s:=s+inttostr(j)+'-й '; tmp:=tmp+1;
r:=r+strtofloat(x[i,j])*c[i,j];
end;
if tmp>1 then s:=s+'склады ' else s:=s+'склад ';
s:=s+' ('+inttostr(i)+'-й маршрут).';
form1.Memo1.Lines.Append(s);
end;
tmp:=0;
if rw1<rw then begin
for j:=1 to cl do if not (x[rw,j]='------------')
then tmp:=tmp+strtofloat(x[rw,j]);
form1.Memo1.Lines.Append('Не доставлено '+floattostr(tmp)+' партий товара.');
end;
s:='Расходы составят '+floattostr(r)+' у.е.';
form1.Memo1.Lines.Append(s);
form1.Memo1.Lines.Append('--------------------------------------------------------------------------');
end;
procedure TForm1.Button3Click(Sender: TObject);
var i,j:integer;
s:string;
begin
if (form1.prdl.text='')or(form1.spr.text='') then begin beep;
MessageDLG('Проверьте правильность введенных данных!', mtError, [mbOK], 0);
exit;end;
val(form1.prdl.text,cl,t);
val(form1.spr.text,rw,t);
if (cl>7)or(rw>7) then begin beep;
MessageDLG('Нельзя вводить такую большую размерность!', mtError, [mbOK], 0);
exit;end;
form1.spros.colcount:=cl;
form1.predl.rowcount:=rw;
form1.bitbtn1.Enabled:=true;
label3.Enabled:=true;
label4.Enabled:=true;
label5.Enabled:=true;
label6.Enabled:=true;
label8.Enabled:=true;
Button2.Enabled:=true;
form1.predl.Enabled:=true;
form1.spros.Enabled:=true;
form1.tab1.Enabled:=true;
form1.Memo1.Enabled:=true;
// Очистка таблиц
for t:=0 to 100 do
for i:=0 to 100 do begin
form1.tab1.Cells[i,t]:='';
form3.sg1.Cells[i,t]:='';
end;
for t:=1 to cl do begin
str(t,s);
form1.tab1.Cells[t,0]:=s;
form3.sg1.Cells[t,0]:=s;
end;
ch[1]:='A'; ch[2]:='Б'; ch[3]:='В';
ch[4]:='Г'; ch[5]:='Д'; ch[6]:='Е';
for t:=0 to rw do begin
form1.tab1.Cells[0,t]:=ch[t];
form3.sg1.Cells[0,t]:=ch[t];
end;
form1.tab1.Cells[0,0]:='';
form3.sg1.Cells[0,0]:='';
end;
procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
c[1,1]:=20; c[1,2]:=40; c[1,3]:=15; c[1,4]:=30;
c[2,1]:=10; c[2,2]:=25; c[2,3]:=25; c[2,4]:=35;
c[3,1]:=15; c[3,2]:=45; c[3,3]:=30; c[3,4]:=20;
for t:=1 to cl do
for i:=1 to rw do form1.tab1.Cells[t,i]:=floattostr(c[i,t]);
spl[1]:=60; spl[2]:=100; spl[3]:=80;
dmd[1]:=70; dmd[2]:=50; dmd[3]:=90; dmd[4]:=30;
for t:=1 to rw do form1.predl.Cells[0,t-1]:=floattostr(spl[t]);
for t:=1 to cl do form1.spros.Cells[t-1,0]:=floattostr(dmd[t]);
end;
function TForm1.read_data():bool;
var i,j: integer;
begin
try
for i:=1 to rw do
for j:=1 to cl do
c[i,j]:=strtofloat(form1.tab1.Cells[j,i]);
sspl:=0;
for i:=1 to rw do begin
spl[i]:=strtofloat(form1.predl.Cells[0,i-1]);
sspl:=sspl+spl[i];
end;
sdmd:=0;
for i:=1 to cl do begin
dmd[i]:=strtofloat(form1.spros.Cells[i-1,0]);
sdmd:=sdmd+dmd[i];
end;
read_data:=true;
except on EConvertError do
begin
MessageDLG('Проверьте правильность введенных данных!', mtError, [mbOK], 0);
read_data:=false;
exit;
end;
end;
end;
procedure TForm1.balans();
var i,j: integer;
begin
rw1:=rw;
if sspl>sdmd then begin
showmessage('Задача не сбалансирована! Добавляем столбец.');
cl:=cl+1;
for i:=1 to rw do begin form1.tab1.Cells[cl,i]:='0'; x[i,cl]:='0'; end;
form1.tab1.Cells[cl,0]:=inttostr(cl);
form3.sg1.Cells[cl,0]:=inttostr(cl);
dmd[cl]:=sspl-sdmd;
form1.spros.colcount:=cl;
form1.spros.cells[cl-1,0]:=floattostr(dmd[cl]);
end;
if sspl<sdmd then begin
showmessage('Задача не сбалансирована! Добавляем строку.');
rw1:=rw;
rw:=rw+1;
for i:=1 to cl do begin form1.tab1.Cells[i,rw]:='0'; x[rw,i]:='0'; end;
form1.tab1.Cells[0,rw]:=ch[rw];
form3.sg1.Cells[0,rw]:=ch[rw];
spl[rw]:=sdmd-sspl;
form1.predl.rowcount:=rw;
form1.predl.cells[0,rw-1]:=floattostr(spl[rw]);
end;
end;
procedure TForm1.First_resh();
var
ci,ri: byte;
i,j: integer;
tmp:real;
begin
for i:=1 to rw+1 do
for j:=1 to cl+1 do x[i,j]:='------------';
ri:=1; ci:=1;
while ((ri<=rw) and (ci<=cl)) do begin
if spl[ri]<dmd[ci] then tmp:=spl[ri] else tmp:=dmd[ci];
x[ri,ci]:=floattostr(tmp);
spl[ri]:=spl[ri]-tmp;
dmd[ci]:=dmd[ci]-tmp;
if spl[ri]=0 then ri:=ri+1;
if dmd[ci]=0 then ci:=ci+1;
end;
end;
procedure TForm1.find_uv();
var
vc,uc: array [1..100] of integer;
ind,i,j: integer;
begin
for i:=1 to cl do begin v[i]:=0; vc[i]:=0; end;
for i:=2 to rw do begin u[i]:=0; uc[i]:=0; end;
u[1]:=0; uc[1]:=1;
for t:=1 to rw do
for ind:=1 to rw do begin
//цикл для V
for i:=1 to cl do
if(not(x[ind,i]='------------'))and(uc[ind]=1) then begin
v[i]:=c[ind,i]-u[ind];
vc[i]:=1;
end;
if not (ind=rw) then
for j:=1 to cl do
if(not(x[ind+1,j]='------------'))and(vc[j]=1) then begin
u[ind+1]:=c[ind+1,j]-v[j];
uc[ind+1]:=1;
end;
end;
for i:=1 to rw do
for j:=1 to cl do begin
if (x[i,j]='------------') then xnb[i,j]:=u[i]+v[j]-c[i,j]
else xnb[i,j]:=0;
end;
end;
procedure TForm1.xnbmax(var max:real;var xi,yi:integer);
var
i,j:integer;
begin
max:=0; xi:=1; yi:=1;
for i:=1 to rw do
for j:=1 to cl do begin
if (max<xnb[i,j]) and (x[i,j]='------------') then begin
max:=xnb[i,j];
xi:=i; yi:=j;
end
end;
end;
procedure TForm1.print_tabl();
var
i,j: integer;
begin
for i:=1 to rw do
for j:=1 to cl do
form3.sg1.Cells[j,i]:=x[i,j];
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
form2.Visible:=true;
end;
end.