Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 23.04.2011, 16:00
Skiph Skiph вне форума
Прохожий
 
Регистрация: 23.04.2011
Сообщения: 3
Репутация: 10
Восклицание Помогите пожалуйста с "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;

Привожу код всей процедуры:

Код:
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;
Ответить с цитированием
  #2  
Старый 23.04.2011, 16:38
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

вообще эта ошибка может появлятся хоть из за чего, и в чем дело очень трудно понять...
могу предложить использовать вместо типа real, тип double или single..
или переменные объяви не в процедуре, а в начале модуля... мне иногда помогает
Ответить с цитированием
  #3  
Старый 30.04.2011, 21:30
Skiph Skiph вне форума
Прохожий
 
Регистрация: 23.04.2011
Сообщения: 3
Репутация: 10
По умолчанию

Все оказалось проще.. дело было в размерности матрицы. 200х200 было маловато. Спс за ответ!
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 07:25.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter