# [TP] Szalone obliczenia z systemem mrówkowym i probemy TP

0

Mam taki kod:

``````program komiwoj;

uses Crt, Graph;

type
ptr = ^town;
town = record
x,
y: word;
num:byte;
prev,
next:ptr;
end;

neighbour = array [0..50] of array [0..50] of boolean;
antferom  = array [0..50] of array [0..50] of double;
probabtab = array [0..50] of double;
bannedcit = array [0..50] of boolean;
pass      = array [0..50] of byte;
bestpasslen = double;

function power(const x,y : double) : double;
begin
power := exp(ln(abs(x))*y);
end;

var
ntown:ptr;
begin
new(ntown);
ntown^.x:=x;
ntown^.y:=y;
ntown^.prev:=nil;
ntown^.next:=nil;
if tail<>nil then
begin
ntown^.next:=tail^.next;
if ntown^.next<>nil then
ntown^.next^.prev:=ntown;
tail^.next:=ntown;
ntown^.prev:=tail;
ntown^.num:=tail^.num+1;
tail:=ntown;
end
else
begin
tail:=ntown;
tail^.num:=0;
end;
end;

var
f:text;
x,y:byte;
a:string;
begin
x:=0;
y:=0;
assign(f, 'nb.txt');
reset(f);
while not eof(f) do
begin
for y:=0 to length(a)-1 do
begin
if (a[y+1]='0') then
tab[x,y]:=false
else
tab[x,y]:=true;
end;
x:=x+1;
end;
close(f);
end;

procedure Pars(const s:string; var ix, iy: integer);
var
x,y:string;
ciach:integer;
begin
ciach:=Pos(',',s);
x:=copy(s,1,ciach-1);
y:=copy(s,ciach+1,(length(s)-ciach));
val(x, ix, ciach);
val(y, iy, ciach);
end;

var
f:text;
x,y:integer;
a:string;

begin
x:=0;
y:=0;
assign(f, 'tw.txt');
reset(f);
while not eof(f) do
begin
if a='' then
continue;
pars(a, x, y);
end;
close(f);
end;

var
i: byte;
tmpptr: ptr;
begin
for i:=0 to tail^.num do
begin
while tmpptr^.num<>bestpass[i] do
tmpptr:=tmpptr^.next;
end;
end;

function getlen(const x, y: byte; const head, tail: ptr) : double;
var
xptr,
yptr:ptr;

begin
while xptr^.num<>x do
xptr:=xptr^.next;
while yptr^.num<>y do
yptr:=yptr^.next;

getlen:= sqrt( sqr(yptr^.x - xptr^.x) + sqr(yptr^.y - xptr^.y) );
end;

var
tmpptr:ptr;
begin
sterownik:=Detect;
InitGraph( sterownik, tryb, './BGI');
begin
WriteLn('Sie skopcila grafika');
write('mowi ze ja boli ', blad);
Halt;
end;
while tmpptr<>nil do
begin
LineTo(tmpptr^.x, tmpptr^.y);
tmpptr:=tmpptr^.next;
end;
CloseGraph;
end;

procedure antmoves(const head, tail: ptr; const tab: neighbour; var bestpass: pass);
var
iters, numcit, currcit, trycnt, tabued: byte;
antpopul, antnum: word;
tmprt: integer;
ferr: antferom;
prob: probabtab;
tabu: bannedcit;
pas: pass;

const
antfer=0.1; {ilość zostawianego feromonu}
antdefer=0.3; {szybkość odparowywania: 30%}
alfa = 0.5;{znaczenie feromonu}
beta = 3.5;{znaczenie widoczności}
{antpopul = 100;} {wielkosc popuacji mrowek, najlepiej by bylo 2*iosc miast.}
maxiters = 100; {liczba iteracji, im wiencej tym lepiej, tym dluzej}
maxtry = 10; {maksymalna liczba powrotow, po blendnie dobranej trasie, im wieej tym lepiej, tym wolniej}

procedure SetUpFerr;
var
x, y: byte;
begin
for x:=0 to numcit do
for y:=0 to numcit do
ferr[x, y]:=0.01;
end;

procedure SetUpTabu;
var
t: byte;
begin
for t:=0 to numcit do
tabu[t]:=false;
end;

procedure SetUpPass;
var
t: byte;
begin
for t:=0 to numcit do
pas[t]:=0;
end;

procedure makeprobtab(const x: byte);

function sum: double;
var
y: byte;
ret: double;
begin
ret:=0;
for y:=0 to numcit do
if (tabu[y] = false) and (tab[x, y] = true) and (x<>y) then
ret:=ret+(power(ferr[x,y], alfa) * power( 1/getlen(x,y,head,tail), beta));
sum:=ret;
end;

var
y: byte;
begin
for y:=0 to numcit do
begin
if (tabu[y] = true) or (tab[x, y] = false) or (x=y) then
prob[y]:=0
else
prob[y]:= (power(ferr[x,y], alfa) * power( 1/getlen(x,y,head,tail), beta))/sum;
end;
end;

function selectroute: integer; {select route from 5 most possible}
var
y:byte;
ymax: integer;
max, lastmax:double;
ra: array[0..4] of integer;
begin
for y:=0 to 4 do
ra[y]:=-1;
max:=0;
ymax:=-1;
for y:=0 to numcit do
if prob[y]>max then
begin
max:=prob[y];
ymax:=y;
end;
if ymax<>-1 then
ra[2]:=ymax
else
begin
{no possible routes}
writeln('poszło sie jebać');
selectroute:=-1;
exit;
end;
lastmax:=max;
max:=0;
ymax:=-1;
for y:=0 to numcit do
if (prob[y]>max) and (prob[y]<lastmax) then
begin
max:=prob[y];
ymax:=y;
end;
if ymax<>-1 then
ra[3]:=ymax
else
begin
{jetna droka}
selectroute:=ra[3];
exit;
end;
{mamy wincy nisz jetno droke, to zie bafimy}
lastmax:=max;
max:=0;
ymax:=-1;
for y:=0 to numcit do
if (prob[y]>max) and (prob[y]<lastmax) then
begin
max:=prob[y];
ymax:=y;
end;

ra[1]:=ymax;
lastmax:=max;
max:=0;
ymax:=-1;
for y:=0 to numcit do
if (prob[y]>max) and (prob[y]<lastmax) then
begin
max:=prob[y];
ymax:=y;
end;
ra[4]:=ymax;
lastmax:=max;
max:=0;
ymax:=-1;
for y:=0 to numcit do
if (prob[y]>max) and (prob[y]<lastmax) then
begin
max:=prob[y];
ymax:=y;
end;
ra[0]:=ymax;
lastmax:=max;
repeat
y:=random(5);
until ra[y]<>-1;
selectroute:=ra[y];
end;

procedure VaporFerr;
var
x,y:byte;
begin
for x:=0 to numcit do
for y:=0 to numcit do
ferr[x,y]:=ferr[x,y] * (1-antdefer);
end;

var
x: byte;
ret: double;
begin
ret:=0;
for x:=1 to numcit do
begin
end;
end;

procedure passage;
var
x: byte;
begin
for x:=0 to numcit do
begin
bestpass[x]:=pas[x];
end;
end;

var
x:byte;
begin
for x:=1 to numcit do
begin
end;
end;

begin
iters:=0;
numcit:=tail^.num;
antpopul:=numcit*2;
SetUpFerr;
Writeln('Generating...');
repeat
write('Iter ', iters,'; ant:');
for antnum:=1 to antpopul do
begin
write(antnum, ', ');
SetUpTabu;
SetUpPass;
pas[0]:=0;
tabu[0]:=true;
currcit:=0;
trycnt:=0;
repeat
makeprobtab(pas[currcit]);
tmprt:=selectroute;
if tmprt=-1 then
begin
if currcit=0 then
begin
writeln('ozeszek ty mac');
exit;
end;
currcit:=currcit-1;
trycnt:=trycnt+1;
if trycnt=maxtry then
begin
writeln('ni ma szczynscia');
exit;
end;
continue;{to wykopie do poczatku penti jak jest ok}
end;
{jakezesmy dotarli tutej to jest dopze}
currcit:=currcit+1;
pas[currcit]:=tmprt;
tabu[pas[currcit]]:=true;
until pas[numcit]<>0;{koncowa droga, szit, straszny ten warunek}
{tu jestesmy, znaczy ze droga przeszla, uff, a moglo sie zle skonczyc, bo jak moze nie byc sasiadow to jest straszna lipa}
begin
passage;
end;
begin
distferr(road);{im krutsza droga tym wiencej feromonu}
end;
end;
VaporFerr;
iters:=iters+1;
writeln;
until iters=maxiters;
end;

var
nb: neighbour;
bestpass: pass;

begin
end.``````

przy zawartości pliku nb.txt:

``````0111111111
1011111111
1101111111
1110111111
1111011111
1111101111
1111110111
1111111011
1111111101
1111111110``````

i tw.txt:

``````10,10
45,20
100,230
55,300
550,400
510,1
1,420
320,240
123,456
250,150``````

program wykrzaza się przy obliczaniu długości pierwszej drogi z błędem Floating Point Overflow, podczas gdy ta droga nie powinna być dłuższa przy pierwszym obliczeniu (1 i 2) niż 36,4.

//ps. nie wiem czemu ale znaczniki delphi i code wstawiają w cholere enterów.

0

Wybacz, że tak z grubej rury przywalę, bo nie czytałem kodu bo jest dośc długi natomiast na podstawie tego co piszesz sugeruje sprawdzić czy gdzieś nie ma odwołania do niezainicjowanej zmiennej zmiennoprzecinkowej , wtedy często występuje floatig point overflow. np:

``````
procedure procka;
var x,y:double;
begin
x:=y;// już tu może wystąpić floating point overflow bo zmienna y może nie byc zainicjowana(w zasadzie z tego co pamiętam to nie jest zainicjowana na większości chyba kompilatorów borlanda i z resztą słusznie) i następuje odwołanie do 8 bajtów , które zinterpretowane jako liczba double nie mieszczą się w zakresie przewidzianym dla tego formatu
end;``````
0

Oj, dokadnie sprawdzałem, ale najwidoczniej doszukać się nie mogę. Wszystko na czym cokolwiek polega jest wcześniej inicjalizowane.

Dodatkowo ponowne skompilowanie kodu bez przeglądania, tylko usunięty graph a metoda go wykorzystująca zmieniona na wyświetlającą kolejne współrzędne, problem z floating point overflow znika, natomiast funkcja wybierająca dobrą drogę nie może sobie poradzić ze zwróceniem dobrego wyniku, mimo iż tablica prawdopodobieństw jest wypełniona... ta, tyle że te wartości są dość dziwne, jak ktoś ma czas to niech skompiluje sobie i przepatrzy, ja nie mam już cierpliwości do pascala. FreePascal odstawia głupoty na tym wykraczając się na operacjach z wskaźnikami.