procedure TMainView.PlanOptimum;
Label 1;
var
i,y,j,k,ck,f,h,mmin:integer;
S: array [1..200,1..200] of real;
R,L,T,B,D:bool;
begin
R:= true; L:= true; // флаги Правый, Левый
T:= true; B:= true; // флаги Вверх, Ввниз
j:=1; k:=1;
S[1,1]:=i1;
S[1,2]:=y1;
S[1,3]:=matpost[i1,y1];
maket[i1,y1]:='0';
// вычеркнуть столбцы и строки невходящие в контур
repeat begin
f:=0; h:=0;
//вычеркиваем строки
for i:=1 to ai do begin
for y:=1 to bj do
if maket[i,y]='0' then inc(f);
if f=1 then begin
for y:=1 to bj do maket[i,y]:='-';
inc(h);
end;
f:=0;
end;
// вычеркиваем столбцы
f:=0;
for y:=1 to bj do begin
for i:=1 to ai do
if maket[i,y]='0' then inc(f);
if f=1 then begin
for i:=1 to ai do maket[i,y]:='-';
inc(h);
end;
f:=0;
end;
end;
until (h=0);
//построение контура
repeat
i:=Ceil(S[k,1]); y:=Ceil(S[k,2]);
if (i<>ai) and (B=true) then begin
i:=i+1;
while ((maket[i,y]<>'0') and (i<>ai)) do
inc(i);
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
inc(j);
k:=j-1;
T:=false;
R:=true;
L:=true;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
i:=Ceil(S[k,1]);
if (i<>1) and (T=true) then begin
i:=i-1;
while ((maket[i,y]<>'0') and (i<>1)) do
i:=i-1;
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
inc(j);
k:=j-1;
R:=true;
L:=true;
B:=false;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
i:=Ceil(S[k,1]);
y:=Ceil(S[k,2]);
if (y<>bj) and (R=true) then begin
y:=y+1;
while ((maket[i,y]<>'0') and (y<>bj)) do
inc(y);
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
inc(j);
k:=j-1;
L:=false;
B:=true;
t:=true;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
y:=Ceil(S[k,2]);
if (y<>1) and (L=true) then begin
y:=y-1;
while ((maket[i,y]<>'0') and (y<>1)) do
y:=y-1;
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
T:=true;
B:=true;
R:=false;
inc(j);
k:=j-1;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
i:=Ceil(S[k,1]);
if (i<>1) and (T=true) then begin
i:=i-1;
while ((maket[i,y]<>'0') and (i<>1)) do
i:=i-1;
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
inc(j);
k:=j-1;
B:=false;
R:=true;
L:=true;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
i:=Ceil(S[k,1]);
if (i<>ai) and (B=true) then begin
i:=i+1;
while ((maket[i,y]<>'0') and (i<>ai)) do
inc(i);
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
inc(j);
k:=j-1;
L:=true;
R:=true;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
i:=Ceil(S[k,1]); y:=Ceil(S[k,2]);
if (y<>1) and (L=true) then begin
y:=y-1;
while ((maket[i,y]<>'0') and (y<>1)) do
y:=y-1;
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
B:=true;
T:=true;
R:=false;
inc(j);
k:=j-1;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
y:=Ceil(S[k,2]);
if (y<>bj) and (R=true) then begin
y:=y+1;
while ((maket[i,y]<>'0') and (y<>bj)) do
inc(y);
if (maket[i,y]='0') then begin
S[j,1]:=i;
S[j,2]:=y;
S[j,3]:=matpost[i,y];
inc(j);
k:=j-1;
B:=true;
R:=true;
end;
if (i=i1) and (y=y1) then begin
T:=false; B:=false; R:=false; L:=false;
end;
end;
i:=Ceil(S[k,1]); y:=Ceil(S[k,2]);
until (i=i1) and (y=y1);
j:=1;
mmin:=Ceil(S[1,3]); // минимум контура
while j<=k-1 do begin
if mmin>S[j,3] then
mmin:=Ceil(S[j,3]);
j:=j+2;
end;
//составить новый план в соответствии с контуром
j:=1;
while j<>k+1 do begin
matpost[Ceil(S[j,1]),Ceil(S[j,2])]:=S[j,3]-mmin;
matpost[Ceil(S[j+1,1]),Ceil(S[j+1,2])]:=S[j+1,3]+mmin;
j:=j+2;
end;
// создать макет нового плана
for i:=1 to ai do
for y:=1 to bj do begin
if matpost[i,y]<>0 then maket[i,y]:='0'
else maket[i,y]:='-';
end;
// проверка на вырожденость
ck:=0;
for i:=1 to ai do
for y:=1 to bj do begin
if matpost[i,y]<>0 then
ck:=ck+1;
end;
// если минимум контура равен "0"
//обозначить в макете клетку с максимальным расхождениема как заполненую
if mmin=0 then
begin
maket[i1,y1]:='0';
txtTip.Caption:='Минимальное заначение контура = 0. Перенесем его в клетку с максимальным рассогласованием. Целевая функция не изменилась, так как объем перевозок изменен не был.';
end
else
// если новый полученный план вырожденый
// обозначить в макете нового плана любую клетку контура = 0, как заполненую
if ck<n-1 then
begin
txtTip.Caption:='Полученый план вырожденый так как количество перевозок на нем ' + IntToStr(ck) + ' < n+m-1='+IntToStr(n-1)+'. Для не вырождености плана обозначим любую клетку контура = Нуль, как выполненую перевозку в объеме 0.';
{while (ck<>n-1) do}
For i:=1 To ai Do
For y:=1 To bj Do
if (matpost[i,y]=0) then
begin
StGpostav.Cells[y,i]:='Нуль';
maket[i,y]:='0';
ck:=ck+1;
If (ck = n-1) Then
goto 1;
end;
1:end
else
txtTip.Caption:='Полученый план не вырожденый, так как количество перевозок на нем = n+m-1='+IntToStr(n-1)+'. Проверте его на оптимальность.';
cFunction;
end;
Помогите с "Invalid floating point operation"
В общем программа по задумке решает транспортную задачу, поиск кратчайших путей и нахождение опорного плана проходят нормально, но сама оптимизация за методом потенциалов выпадает с ошибкой:
Exception class EInvalidOp with message "Invalid floating pooint operation"
Говорю сразу, код оптимизации не полностью мой код, по этому тяжело разобраться в чем ошибка, может кто-то с опытом сможет подсказать?
п.с.: еще важный момент, в примере откуда был взят код, он прекрасно работает, но там матрица входящая 3х5 а в моем случае 106х2
Проблемный участок указанный дебаггером:
//составить новый план в соответствии с контуром
j:=1;
while j<>k+1 do begin
matpost[Ceil(S[j,1]),Ceil(S[j,2])]:=S[j,3]-mmin;
matpost[Ceil(S[j+1,1]),Ceil(S[j+1,2])]:=S[j+1,3]+mmin;
j:=j+2;
end;
Привожу код всей процедуры:
Exception class EInvalidOp with message "Invalid floating pooint operation"
Говорю сразу, код оптимизации не полностью мой код, по этому тяжело разобраться в чем ошибка, может кто-то с опытом сможет подсказать?
п.с.: еще важный момент, в примере откуда был взят код, он прекрасно работает, но там матрица входящая 3х5 а в моем случае 106х2
Проблемный участок указанный дебаггером:
//составить новый план в соответствии с контуром
j:=1;
while j<>k+1 do begin
matpost[Ceil(S[j,1]),Ceil(S[j,2])]:=S[j,3]-mmin;
matpost[Ceil(S[j+1,1]),Ceil(S[j+1,2])]:=S[j+1,3]+mmin;
j:=j+2;
end;
Привожу код всей процедуры:
Код:
Если выложите проект можно будет взглянуть.
спасибо за ответ, оказалось дело в малой размерности матрицы