Курсовая работа: Транспортная задача по критериям стоимости и времени
12. Проверяем матрицу С(2) на наличие отрицательных элементов. Если такие элементы присутствуют, то повторяем пункты с 5 по11.
13. Если во время решения достоверность результатов нарушается, прекращаются дальнейшие вычисления, пользователю выдается информация об ошибке.
14. Дооптимизация по времени.
14.1. Ищем отличный от нуля элемент в матрице X(k), которому соответствует наибольший элемент матрицы Т=tmax.
14.2. Ищем в матице С(k) нули соответствующие таким нулям в матрице X(k), что соответствующие им элементы матрицы Т меньше tmax.
14.3. Если в предыдущем пункте нашелся хоть один ноль, то производим процедуры пунктов 7-10.
14.4. Переходим к пункту 14.1.
15. Вывод результатов.
6. Листинг программы, реализующий алгоритм задачи
const
color=TColor(Clred);
var i,j,v,w:integer;
err,kon:boolean;
str:String;
begin
kon:=true;
Label3.Caption:='';
for j:=1 to StringGrid1.RowCount-1 do
if (StringGrid1.Cells[1,j]='')or(StringGrid1.Cells[0,j]='')then
kon:=false;
for j:=1 to StringGrid2.RowCount-1 do
if (StringGrid2.Cells[1,j]='')or(StringGrid2.Cells[0,j]='')then
kon:=false;
if kon=true then
begin
err:=true;
for j:=1 to StringGrid1.RowCount-1 do
begin
Str:=Trim(StringGrid1.Cells[1,j]);
Recurs(str,1,err);
If err=false then
begin
StringGrid1.Canvas.Brush.color := color;
StringGrid1.canvas.fillRect(StringGrid1.CellRect(1,j));
StringGrid1.canvas.TextOut(StringGrid1.CellRect(1,j).Left,StringGrid1.CellRect(1,j).Top,StringGrid1.Cells[1,j]);
Label3.Caption:= ’Выделенные значения не верны';
end;
Err:=true;
end;
for j:=1 to StringGrid2.RowCount-1 do
begin
Str:=Trim(StringGrid2.Cells[1,j]);
Recurs(str,1,err);
If err=false then
begin
StringGrid2.Canvas.Brush.color := color;
StringGrid2.canvas.fillRect(StringGrid2.CellRect(1,j));
StringGrid2.canvas.TextOut(StringGrid2.CellRect(1,j).Left,StringGrid2.CellRect(1,j).Top,StringGrid2.Cells[1,j]);
Label3.Caption:= ‘Выделенные значения не верны';
end;
Err:=true;
end;
for j:=1 to StringGrid1.RowCount-1 do
begin
Str:=Trim(StringGrid1.Cells[1,j]);
Recurs(str,1,err);
end;
for j:=1 to StringGrid2.RowCount-1 do
begin
Str:=Trim(StringGrid2.Cells[1,j]);
Recurs(str,1,err);
end;
If err=true then
begin
for j:=1 to StringGrid1.RowCount-1 do
begin
If (StrToInt(trim(StringGrid1.Cells[1,j]))<0)or(StrToInt(trim(StringGrid1.Cells[1,j]))>190)
then
begin
StringGrid1.Canvas.Brush.color := color;
StringGrid1.canvas.fillRect(StringGrid1.CellRect(1,j));
StringGrid1.canvas.TextOut(StringGrid1.CellRect(1,j).Left,StringGrid1.CellRect(1,j).Top,StringGrid1.Cells[1,j]);
err:=false;
Label3.Caption:= ‘Выделенные значения не верны';
end;
end;
for j:=1 to StringGrid2.RowCount-1 do
begin
If (StrToInt(trim(StringGrid2.Cells[1,j]))<0)or(StrToInt(trim(StringGrid2.Cells[1,j]))>160)
then
begin
StringGrid2.Canvas.Brush.color := color;
StringGrid2.canvas.fillRect(StringGrid2.CellRect(1,j));
StringGrid2.canvas.TextOut(StringGrid2.CellRect(1,j).Left,StringGrid2.CellRect(1,j).Top,StringGrid2.Cells[1,j]);
err:=false;
Label3.Caption:= ‘Выделенные значения не верны';
end;
end;
if err=true then
begin
w:=0;//ai
v:=0;//bj
SetLength(c,StringGrid2.RowCount-1,StringGrid1.RowCount-1);
SetLength(t,StringGrid2.RowCount-1,StringGrid1.RowCount-1);
SetLength(a,StringGrid1.RowCount-1);
SetLength(b,StringGrid2.RowCount-1);
//Проверка условия баланса
For i:=1 to StringGrid1.RowCount-1 do
w:=w+StrToint(Trim(StringGrid1.cells[1,i]));
For i:=1 to StringGrid2.RowCount-1 do
v:=v+StrToint(Trim(StringGrid2.cells[1,i]));
if w<v then
begin
Setlength(c,(StringGrid2.RowCount-1),(StringGrid1.RowCount));
SetLength(a,StringGrid1.RowCount);
for i:=0 to Length(c)-1 do
begin
c[i,Length(c[1])-1]:=1000;
end;
a[length(a)-1]:=v-w;
end;
if w>v then
begin
Setlength(c,(StringGrid2.RowCount),(StringGrid1.RowCount-1));
SetLength(b,StringGrid2.RowCount);
for i:=0 to Length(c[1])-1 do
begin
c[length(c)-1,i]:=1000;
end;
b[length(b)-1]:=w-v;
end;
For i:=0 to StringGrid1.RowCount-2 do
a[i]:=StrtoInt(Trim(StringGrid1.cells[1,i+1]));
For i:=0 to StringGrid2.RowCount-2 do
b[i]:=StrtoInt(Trim(StringGrid2.Cells[1,i+1]));
For i:=1 to StringGrid1.RowCount-1 do
begin
Form3.StringGrid1.Cells[0,i]:=StringGrid1.cells[0,i];
Form3.StringGrid2.Cells[0,i]:=StringGrid1.cells[0,i];
end;
For i:=1 to StringGrid2.RowCount-1 do
begin
Form3.StringGrid1.Cells[i,0]:=StringGrid2.cells[0,i];
Form3.StringGrid2.Cells[i,0]:=StringGrid2.cells[0,i];
end;
Form3.Show;
Form5.Close;
end;
end;
end
else ShowMessage('Заполните все поля');
procedure Potencial(x:Tmatr; u,v:Tmas; var z:Tmatr );
var
i,j,k,r:integer;
begin
SetLength(u,length(x[1]));
SetLength(v,Length(x));
For r:=0 to Length(x)-1 do
v[r]:=-1000;
for j:=0 to Length(x[1])-1 do
u[j]:=-1000;
u[0]:=0;
For r:=0 to Length(x)-1 do
for j:=0 to Length(x[1])-1 do
begin
for i:=0 to Length(x)-1 do
if (x[i,j]<>0) and (v[i]=-1000)then
if (u[j]<>-1000)then
v[i]:=c[i,j]+u[j];
For i:=0 to Length(x)-1 do
if v[i]<>-1000 then
for k:=0 to Length(x[1])-1 do
if (k<>j)and(x[i,k]<>0)and(u[k]=-1000)then
u[k]:=v[i]-c[i,k];
end;
Setlength(z,Length(c),Length(c[1]));
For i:=0 to Length(x)-1 do
For j:=0 to Length(x[1])-1 do
z[i,j]:=c[i,j]-(v[i]-u[j]);
end;
//Проверкана вырожденость
procedure Virogden(var x:Tmatr);
var i,j,r,k,d:integer;
h,g:boolean;
begin
d:=0;
For i:=0 to Length(x)-1 do
for j:=0 to length(x[1])-1 do
if x[i,j]<>0 then d:=d+1;
if d<Length(x)+Length(x[1])-1 then
For i:=0 to Length(x)-2 do
for j:=0 to Length(x[1])-2 do
begin
if x[i,j]>0 then
begin
h:=true;
g:=true;
for r:=i+1 to Length(x)-1 do
if x[r,j]>0 then
h:=false;
for k:=j+1 to Length(x[1])-1 do
if x[i,k]>0 then
g:=false;
if(h=true)and(g=true) then
x[i,j+1]:=-2;
end;
end;
end;
procedure Opornplan(StringGrid1:TStringGrid; var x,z:Tmatr);
var i,j:integer;
c1:TMatr;
begin
Setlength(x,Length(c),Length(c[1]));
Setlength(c1,Length(x)*Length(x[1]),3);
For i:=0 to Length(x)-1 do
for j:=0 to Length(x[1])-1 do
begin
c1[(Length(x[1]))*i+j,0]:=c[i,j];
c1[(Length(x[1]))*i+j,1]:=i;
c1[(Length(x[1]))*i+j,2]:=j;
end;
Setlength(z,1,3);
//Сортировка
For i:=0 to Length(c1)-2 do
for j:=0 to Length(c1)-2 do
if c1[j,0]>c1[j+1,0] then
begin
z[0]:=c1[j+1];
c1[j+1]:=c1[j];
c1[j]:=z[0];
end;
for i:=0 to Length(x)-1 do
for j:=0 to Length(x[1])-1 do
x[i,j]:=-1;
For i:=0 to Length(x)*Length(x[1])-1 do
if x[c1[i,1],c1[i,2]]=-1 then
begin
//Если à>b
If a[c1[i,2]]>b[c1[i,1]] then
begin
x[c1[i,1],c1[i,2]]:=b[c1[i,1]];
For j:=0 to Length(x[1])-1 do
If x[c1[i,1],j]=-1 then
x[c1[i,1],j]:=0;
a[c1[i,2]]:=a[c1[i,2]]-b[c1[i,1]];
b[c1[i,1]]:=0;
end;
//Если b>a
If a[c1[i,2]]<b[c1[i,1]] then
begin
x[c1[i,1],c1[i,2]]:=a[c1[i,2]];
For j:=0 to Length(x)-1 do
if x[j,c1[i,2]]=-1 then
x[j,c1[i,2]]:=0;
b[c1[i,1]]:=b[c1[i,1]]-a[c1[i,2]];
a[c1[i,2]]:=0;
end;
//Если равны
If a[c1[i,2]]=b[c1[i,1]] then
begin
x[c1[i,1],c1[i,2]]:=a[c1[i,2]];
For j:=0 to Length(x[1])-1 do
if x[c1[i,1],j]=-1 then
x[c1[i,1],j]:=0;
For j:=0 to Length(x)-1 do
If x[j,c1[i,2]]=-1 then
x[j,c1[i,2]]:=0;
a[c1[i,2]]:=0;
b[c1[i,1]]:=0;
end;
end;
//Проверка на вырожденность
Virogden(x);
potencial(x,u,v,z);
end;
procedure Vicherk(var z:TMatr;var err:boolean);
var i,j,min,k:integer;
w,d:Tmas;
begin
SetLength(w,Length(z));
SetLength(d,Length(z[1]));
min:=z[0,0];
k:=0;
For i:=0 to length(w)-1 do
for j:=0 to length(d)-1 do
if z[i,j]<min then
begin
min:=z[i,j];
k:=j;
end;
for i:=0 to length(w)-1 do
if (z[i,k]=0)and(x[i,k]<>0) then
w[i]:=5;
d[k]:=-1;
For k:=0 to length(d)*Length(w)-2 do
begin
for i:=0 to Length(w)-1 do
if w[i]>0 then
begin
for j:=0 to Length(d)-1 do
if (z[i,j]=0)and(x[i,j]<>0)and(d[j]<>-1) then
d[j]:=5;
w[i]:=-1;
end;
For j:=0 to Length(d)-1 do
if d[j]>0 then
begin
for i:=0 to Length(w)-1 do
if (z[i,j]=0)and(x[i,j]<>0)and(w[i]<>-1) then
