关于用delphi 写的蚁群算法的问题
我以前没接触过Delphi,连基本的布局都不知道是否正确,我不知道要再什么环境下运行,希望大家指点,只要能正确运行就可以!谢谢!program VRPTW;
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const inf = 99999999; eps = 1E-8;
type item = integer;
var FN:string; f:System.Text;
procedure T_VRPTW_ANT_RUN;
const maxn = 500;ruo = 0.7; Q=10;
label loop;
type item2 = real;
arr1 = array of array of item;
arr2 = array of array of item2;
arr3 = array of boolean;
arr4 = array of item;
arr5 = array of item2;
var n,i,j,k,l,ii,jj,count,s,maxcount,tweight,index,model,
qq,capa,m,last,selected,tm,weight:item;
tmax,tmin:item2;
datatype:byte;
w,route,opt,cycle:arr1;
t,dt:arr2;
ch:arr3;
x,y:arr5;
len,tlen,nearest,series,demand,kcount,tkcount:arr4;
//求得转移概率P 的功能函数
function PValue(i,j,k:item):item2;
var l:item;
sum:item2;
begin
sum:=0;
for l:=2 to n do
if(capa >= demand[l]) and (ch[l]) and (cycle[k,l] = 0) and(l <> i) then
sum:=sum + t[i,j]/w[i,l];
if(sum > eps) and (cycle[k,j] = 0) and (j <> i) then
sum:=t[i,j]/w[i,j]/sum;
PValue:=sum;
end;
//利用2-opt的方法进行局部优化
procedure TwoOpt(p:item);
var ahead,i,i1,i2,index,j,j1,j2,last,limit,max,next,s1,s2,t1,t2,maxtemp:item;
pt:arr4;
begin
SetLength(pt,n+1);
t1:=1;
t2:=1;
s1:=1;
s2:=1;
for i:=1 to p-1 do
pt[route[k,i]]:=route[k,i+1];
pt[route[k,p]]:=route[k,l];
repeat
maxtemp:=0;
i1:=1;
for i:=1 to p-2 do
begin //1
if i=1 then limit:=p-1
else limit:=p;
i2:=pt[i1];
j1:=pt[i2];
for j:=i+2 to limit do
begin //2
j2:=pt[j1];
max:=w[i1,i2]+w[j1,j2]-(w[i1,i2]+w[i2,j2]);
if(max > maxtemp) then
begin//3
s1:=i1;
s2:=i2;
t1:=j1;
t2:=j2;
maxtemp:=max;
end; //3
j1:=j2;
end;//2
i1:=i2;
end;//1
if(maxtemp > 0) then
Begin//1
pt[s1]:=t1;
next:=s2;
last:=t2;
repeat
ahead:=pt[next];
pt[next]:=last;
last:=next;
next:=ahead;
until next=t2;
end;//1
until(maxtemp=0);
index:=1;
for i:=1 to p do
begin
route[k,i]:=index;
index:=pt[index];
end;
end;
//蚂蚁移动的程序
procedure AntMove;
label lop,select,check,next;
var a,j,k:item;
begin
k:=1;
capa:=qq;
last:=n-1;
for j:=1 to last do
series[j]:=j+1;
for j:=1 to last do
ch[j]:=true;
for j:=1 to last do
kcount[j]:=0;
//lop标签
lop:
nearest[k]:=1;
for j:=1 to n do
cycle[k,j]:=0;
//select标签
select:
a:=nearest[k];
j:=1;
while j<last do
begin
index:=0;
selected:=random(last) + 1;
if(capa >= demand[series[selected]]) then
begin
index:=series[selected];
if(random < PValue(a,index,k)) then goto check;
index:=series[selected];
end;
j:=j + 1;
end;
if index=0 then goto next;
//check标签
check:
cycle[k,nearest[k]]:=index;
nearest[k]:=cycle[k,nearest[k]];
ch[index]:=false;
capa:=capa-demand[index];
kcount[k]:=kcount[k]+1;
last:=last-1;
for j:=selected to last do
series[j]:=series[j+1];
if last >= 1 then goto select;
//next标签
next:
if last >= 1 then
begin
k:=k+1;
capa:=qq;
goto lop;
end;
m := k;
end;
begin
AssignFile(f,FN);
Reset(f);
{$I-}Readln(f,n,datatype,qq,maxcount);{$I+}
if(IOResult<>0) or (n<4) or (n>maxn) or (maxcount < 1) or (datatype < 1)
or(datatype > 2) or (qq <= 0 ) then
begin
ShowMessage('数据错误!');
System.Close(f);
exit;
end;
SetLength(t,n+1,n+1);
SetLength(dt,n+1,n+1);
SetLength(w,n+1,n+1);
SetLength(opt,n+1,n+1);
SetLength(route,n+1,n+1);
SetLength(cycle,n+1,n+1);
if datatype=1 then
begin
SetLength(x,n+1);
SetLength(y,n+1);
for i:=1 to n do
begin
{$I-}Readln(f,ii,x[i],y[i]);{$I+}
if(IOResult<>0) or (ii<>i) then
begin
ShowMessage('数据错误!');
System.Close(f);
exit;
end;
end;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
w[i,j]:=trunc(sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]))+0.5);
w[j,i]:=w[i,j];
t[i,j]:=1;
dt[i,j]:=0;
t[j,i]:=t[i,j];
dt[j,i]:=dt[i,j];
end;
for i:=1 to n do
begin
w[i,i]:=inf;
t[i,i]:=1;
dt[i,i]:=0;
end;
SetLength(x,0);
SetLength(y,0);
end
else
begin
for i:=1 to n-1 do
for j:=i+1 to n do
begin
{$I-}Readln(f,ii,jj,w[i,j]);{$I+}
if(IOResult<>0) or (ii<>i) or(jj<>j) or (w[i,j]<1) then
begin
ShowMessage('数据错误!');
System.Close(f);
exit;
end;
w[j,i]:=w[i,j];
t[i,j]:=1;
dt[i,j]:=0;
t[j,i]:=t[i,j];
dt[j,i]:=dt[i,j];
end;
for i:=1 to n do
begin
w[i,i]:=inf;
t[i,i]:=1;
dt[i,i]:=0;
end;
end;
SetLength(len,n+1);
SetLength(tlen,n+1);
SetLength(series,n+1);
SetLength(nearest,n+1);
SetLength(tkcount,n+1);
SetLength(demand,n+1);
SetLength(kcount,n+1);
SetLength(ch,n+1);
demand[1]:=0;
for i:=2 to n do
Begin
{$I-}Readln(f,ii,demand[i]);{$I+}
if(IOResult<>0) or (ii<>i) or (demand[i]>qq) or (demand[i]<0) then
begin
ShowMessage('数据错误!');
System.Close(f);
exit;
end;
end;
System.Close(f);
FN:=Copy(FN,1,Length(FN)-4)+'.OUT';
ShowMessage('输出结果存入文件:'+FN);
AssignFile(f,FN);
Rewrite(f);
count:=0;
tweight:=inf;
index:=1;
tm:=inf;
randomize;
model:=random(3)+1;
loop:
AntMove;
weight:=0;
for k:=1 to m do
len[k]:=0;
for k:=1 to m do
begin
index:=1;
for i:=1 to kcount[k]+1 do
begin
route[k,i]:=index;
index:=cycle[k,index];
end;
TwoOpt(kcount[k]+1);
len[k]:=w[route[k,kcount[k]+1],route[k,1]];
for i:=1 to kcount[k] do
len[k]:=len[k]+w[route[k,i],route[k,i+1]];
weight:=weight+len[k];
end;
if m<tm then
begin
tm:=m;
tweight:=weight;
for k:=1 to tm do
begin
tkcount[k]:=kcount[k];
for j:=1 to tkcount[k]+1 do
opt[k,j]:=route[k,j];
tlen[k]:=len[k];
end;
end;
if m=tm then
if tweight>weight then
begin
tweight:=weight;
for k:=1 to tm do
begin
tkcount[k]:=kcount[k];
for j:=1 to tkcount[k]+1 do
opt[k,j]:=route[k,j];
tlen[k]:=len[k];
end;
end;
//蚁周、蚁密、蚁量三种模型
for k:=1 to m do
begin
case model of
1:begin
for l:=1 to kcount[k] do
begin
ii:=route[k,l];
jj:=route[k,l+1];
dt[ii,jj]:=dt[ii,jj]+q/len[k];
end;
ii:=route[k,kcount[k]+1];
jj:=route[k,l];
dt[ii,jj]:=dt[ii,jj]+q/len[k];
end;
2:begin
for l:=1 to kcount[k] do
begin
ii:=route[k,l];
jj:=route[k,l+1];
dt[ii,jj]:=dt[ii,jj]+q;
end;
ii:=route[k,kcount[k]+1];
jj:=route[k,l];
dt[ii,jj]:=dt[ii,jj]+q;
end;
3:begin
for l:=1 to kcount[k] do
begin
ii:=route[k,l];
jj:=route[k,l+1];
dt[ii,jj]:=dt[ii,jj]+q/w[ii,jj];
end;
ii:=route[k,kcount[k]+1];
jj:=route[k,l];
dt[ii,jj]:=dt[ii,jj]+q/w[ii,jj];
end;
end;
end;
for i:=1 to n do
for j:=1 to n do
begin
t[i,j]:=ruo*t[i,j]+dt[i,j];
tmax:=1/(tweight*(1-ruo));
tmin:=tmax/5;
if(t[i,j]>tmax) then
t[i,j]:=tmax;
if(t[i,j]<tmin) then
t[i,j]:=tmin;
end;
count:=count+1;
for i:=1 to n do
for j:=1 to n do
dt[i,j]:=0;
if count<maxcount then goto loop;
for k:=1 to tm do
begin
writeln(f);
writeln(f,'第',k,'条路线:');
writeln(f,'回路总长=',tlen[k]);
write(f,'回路路径=');
for j:=1 to tkcount[k]+1 do
write(f,opt[k,j],'');
writeln(f,'1');
end;
writeln(f);
writeln(f,'所需车辆数=',tm);
writeln(f);
writeln(f,'车辆总行程=',tweight);
System.Close(f);
end.