Кадура (Математическое моделирование процессов перевозки грузов железнодорожным транспортом на основе использования задачи коммивояжера), страница 14

begin

TreeArrays[TreeInd].dir[e] :=0; TreeArrays[TreeInd].rev[e] :=0; TreeArrays[TreeInd].indi[e]:=e; TreeArrays[TreeInd]. indj [ej :=e; TreeArrays[TreeInd].consti [e] :=0; TreeArrays[TreeInd].constj [e] :=0; end;

for e:=l to s do begin

TreeArrays[TreeInd].DisableRibsBeg[e]:=0; TreeArrays[TreeInd].DisableRibsEnd[e]:=0; end;

for e:=n+l to n+2*s do

if e mod 2=IsEven then TreeArrays[TreeInd].indj[e]:=0 else TreeArrays[TreeInd]. indi [e] :=0; fore:=l to s do ActiveMen[e]:=0; fore:=l torn do ActiveMen[combination[e]]:=l; for e:=l to s do if ActiveMen[e]=0 then begin

TreeArrays[TreeInd] .indi [n+2 *e-1 ] :=0; TreeArrays [Treelnd]. indj [n+2*e] :=0; end;

Reduction:=true; GetZero:=true; ReductAndGetZero(mas,TreeVariables[TreeInd]^A.svLim,TreeVariables[TreeInd]^A.H, x,y,TreeArrays[TreeInd].consti,TreeArrays[TreeInd].constj, TreeArrays[TreeInd],indi,TreeArrays[TreeInd].indj); if TreeVariables[TreeInd]^A.svLim<svertka then begin

while Treelnd>0 do begin TreeInd:=TreeInd+1;

NewNode(TreeInd,Tree Variables,TreeArrays); InitNode(TreeInd,TreeInd-1 ,TreeVariabIes,TreeArrays); if (x>0)and(y>0) then begin

TreeVariables[TreeInd]^A.QDisableRibs:=l; TreeArrays[TreeInd].DisableRibsBeg[ 1 ] :=x; TreeArrays[TreeInd].DisableRibsEnd[ 1 ] :=y; mas[x,y]:=BigValue;

{Reduction:=true;} GetZero:=false; ReductAndGetZero(mas,TreeVariables[TreeInd]^A.svLim,TreeVariables[TreeInd]^A.H, x,y,TreeArrays[TreeInd].consti,TreeArrays[TreeInd].constj, TreeArrays[TreeInd].indi,TreeArrays[TreeInd].indj); mas[x,y]:=copymas[x,y]; end (if (x>0)and(y>0) then} else TreeVariables[TreeInd]^A.svLim:=RealValue; TreeInd:=TreeInd+1;

NewNode(TreeInd,Tree Variables,TreeArrays); InitNode(TreeInd,TreeInd-2,Tree Variables,TreeArrays); if (x>0)and(y>0) then begin

TreeArrays[TreeInd].indi[x]:=0; TreeArrays[TreeInd] .indj [y] :=0;

TreeVariables[TreeInd]^A.dim:=TreeVariables[TreeInd]^A.dim-1;

TreeArrays[TreeInd].dir[x]:=y;

TreeArrays[TreeInd].rev[y] :=x;

GetPath(TreeArrays[TreeInd].dir,TreeArrays[TreeInd].rev,x,y,p,q); if (q<=n)and(p<=n)and(mas[p,q]<BigValue) then { q не ai, p не bi} begin

TreeVariables[TreeInd]^A.QDisableRibs:=

TreeVariables[TreeInd]^A.QDisableRibs+l;{0H0 становится=1} TreeArrays[TreeInd].DisableRibsBeg[ 1 ] :=p; TreeArrays[TreeInd] .DisableRibsEnd[ 1 ] :=q; mas[p,q] :=BigValue; end;

{Если q>n, p>n и q=p-l то получен один из требуемых маршрутов } if (q>n)and(p>n)and(q=p-l) then

TreeVariables[TreeInd]^A.QFormedPaths:=TreeVariables[TreeInd]^A.QFormedPaths+l; fore:=l to n+2*s do if TreeArrays[TreeInd],indi[e]>0 then for f:=l to n+2*s do

if (TreeArrays[TreeInd].indj[f]>0)and(mas[e,f]<BigValue) then begin

TreeArrays[TreeInd] .dir[e] :=f; TreeArrays[TreeInd] ,rev[f] :=e;

GetPath(TreeArrays[TreeInd].dir,TreeArrays[TreeInd].rev,e,f,p,q); if (q>n)and(p>n)and(((q=p-l)and (m-TreeVariables[TreeInd]^A.QFormedPaths= 1 ))or

((qop-1 )and(m-TreeVariables[TreeInd]^A.QFormedPaths>l))) then begin

mas[e,f]:=BigValue;

TreeVariables[TreeInd]^A.QDisableRibs:=

TreeVariables[TreeInd]^A.QDisableRibs+l;

TreeArrays[TreeInd].DisableRibsBeg[TreeVariables[TreeInd]^A.QDisableRibs]:=e; TreeArrays[TreeInd].DisableRibsEnd[TreeVariables[TreeInd]^A.QDisableRibs]:=f; end;

TreeArrays[TreeInd].dir[e] :=0; TreeArrays[TreeInd].rev[f]:=0;

end; {if (TreeArrays[TreeInd],indj[f]>0)and(nias[e,i]<BigValue)} end (if (x>0)and(y>0) then} else TreeVariables[TreeInd]^A.svLim:=RealValue; TreeVariables[TreeInd-2]^A.done:=true;

ifTreeVariables[TreeInd]^A.dim=2 then begin k:=0;

for e:=l to n+2*s do begin

i f TreeArray s [Treelnd]. indi [e]>0 then for f:=l to n+2*s do

if(TreeArrays[TreeInd].indj[f]>0)and(mas[e,f]<BigValue) then begin k:=k+l;

TreeArrays[TreeInd].dir[e] :=f; TreeArrays[TreeInd].rev[f]:=e; TreeArrays[TreeInd].indi[e] :=0; TreeArrays[TreeInd].indj [f] :=0; break; end;

if k=2 then break; end; if k=2 then begin

fore:=l tosdo for f:=l to n+2 do sol[e,f]:=0; for e:=l to s do begin

VertSol[e]:=0; lenssol[e]:=0; end; fore:=l tosdo

if TreeArrays[TreeInd].dir[n+2 *e-1 ]>0 then begin

f:=n+2*e-l;

sol[e,l]:=f; VertSol[e]:=l; while TreeArrays[Tree!nd].dir[i]>0 do begin

f:=TreeArrays[TreeInd].dir[f]; VertSol [e] :=VertSol [e]+1; sol[e,VertSoI[e]]:=f; end;

end; {ifTreeArrays[TreeInd].dir[n+2*e-l]>0 } fore:=l tosdo if VertSol[e]>0 then

for f:=l to VertSol[e]-l do lenssol[e] :=lenssol [e]+mas[sol [e,f],sol [e,f+1 ]];

sumlenl:=0; for e:=l to s do

sumlen 1 :=sumlen 1+lenssol [e]; maxlenl:=0; for e:=l to s do

if maxlenl<lenssol[e] then maxlenl:=lenssol[e]; svertka 1 :=exp(alpha 1 * 1 n(sumlen 1 ))*exp(alpha2* ln(maxlen 1)); if svertkal<svertka then begin

fore:=l tosdo begin lens[e]:=lenssol[e]; VertQuantity [e] :=VertSol [e]; end;

sumlen:=sumlenl; maxlen:=maxlenl; svertka:=svertkal; fore—l tosdo for f:=l to n+2 do solution[e,f]:=sol[e,f]; end;

end {if k=2 }

else TreeVariables[TreeInd]^A.svLim:=RealValue; end; {if TreeVariables[TreeInd]^A.dim=2 }

if(TreeVariables[TreeInd]^A.dim=2)or(TreeVariables[TreeInd]^A.done=true)or (TreeVariables[TreeInd]^A.svLim>=svertka)then

begin

TreeVariables[TreeInd]^A.done:=true; while (TreeInd>0)and((TreeVariables[TreeInd]^A.done=true)or (TreeVariables[TreeInd]^A.svLim>=svertka))do

begin

if(TreeVariables[TreeInd]^A.done=true)and (TreeVariables[TreeInd]^A.QDisableRibs>0) then for e:=l to TreeVariables[TreeInd]^A.QDisableRibs do mas[TreeArrays[TreeInd].DisableRibsBeg[e]]

[TreeArrays[TreeInd].DisableRibsEnd[e]]:= copymas[TreeArrays[TreeInd].DisabIeRibsBeg[e]] [TreeArrays[TreeInd].DisableRibsEnd[e]]; DisposeNode(TreeInd,Tree Variables,TreeArrays); TreeInd:=TreeInd-1; end;

if Treelnd>0 then

mas[TreeArrays[TreeInd].DisableRibsBeg[l]]

[TreeArrays[TreeInd].DisableRibsEnd[l]]:=BigValue; Reduction:=false; {GetZero:=false;} end;

if Treelnd>0 then begin

GetZero:=true;

if Reduction=false then begin

ReductAndGetZero(mas,Tree Variables[TreeInd]^A.svLim,Tree VariabIes[TreeInd]^A.H, x,y,TreeArrays[TreeInd].consti,TreeArrays[TreeInd].constj, Tree Arrays[TreeInd]. indi,TreeArray s[TreeInd]. indj); Reduction:=true; end else

ReductAndGetZero(mas,TreeVariables[TreeInd]^A.svLim,TreeVariables[TreeInd]^A.H, x,y,TreeArrays[TreeInd].consti,TreeArrays[TreeInd].constj, TreeArrays[TreeInd]. indi,TreeArray s[TreeInd] .indj); end; {if Treelnd>0 } end; { while Treelnd>0 }

end {ifTreeVariables[TreeInd]^A.svLim<svertka} else DisposeNode(TreeInd,Tree Variables,TreeArrays); end; { procedure BnBMethod }

procedure Csm; procedure gen(e,f:integer); var L: integer; begin

if e=0 then BnBMethod(comb) else

for L:=fto s-e+1 do begin

comb[m-e+l]:=a[L]; gen(e-l,L+l); end; end; {gen} begin {Csm} gen(m,l); end; {Csm} begin

StartTime:=Now; rewrite(output);

{ Задача нескольких коммивояжеров: деревья поиска}

assign(fl,'test.txt');

reset(fl);

read(fl,n); {Количество городов } read(fl,s); { Количество коммивояжеров }

read(fl,sq); {0 - фиксированное количество коммивояжеров (<=n), 1 - оптимальное } read(fl,alphal,alpha2); {Показатели важности }

{Выделяем память,инициализируем матрицу задачи mas и ее копию copymas} SetLength(mas,n+2*s+1 ,n+2 *s+1); SetLength(copymas,n+2*s+1 ,n+2*s+1); IsEven:=(n+l) mod 2; for i:=l to n+2*s do begin

for j:=l ton+2*s do begin read(fl,mas[ij]);

if (i>n)and(j>n) then mas[i j]:=BigValue else

begin

if (i>n)and(i mod 2<>IsEven) then mas[i j]:=BigValue; if (j>n)and(j mod 2=IsEven) then mas[ij]:=BigValue; end;

if i=j then mas[i j]:=BigValue; copymas[ij]:=mas[ij]; end;

readln(fl); end;

close(fl);

svertka:=RealValue; SetLength(solution,s+1 ,n+3); {Количество вершин} SetLength(VertQuantity,s+1); {Длины маршрутов} SetLength(lens,s+l); for i:=l to s do for j:=l ton+2 do solution[ij]:=0; for i:=l to s do begin

VertQuantity[i]:=0; lens[i]:=0; end;

SetLength(sol,s+1 ,n+3); SetLength( VertSol,s+1); SetLength(lenssol,s+1); SetLength(a,s+l); SetLength(comb,s+1); SetLength(ActiveMen,s+1); for i:=l to s do a[i]:=i;

if s>n then min:=n else min:=s; if sq=0 then sq:=min else sq:=l; for m:=sq to min do Csm;

assign(fl ,TreesOutput.txt'); rewrite(fl);

writeln(fl,'3HK: метод, использующий деревья поиска');

writeln(fl /Количество городов п = ',п);

writeln(fl,'Количество коммивояжеров s = ',s);

writeln(fl,'Размер матрицы n+2*s = ',n+2*s);

writeln(fl/Решение задачи:');

for i:=l to s do

begin

if VertQuantity [i]>0 then begin

write(fUy);

for j:=l to VertQuantity[i]-l do write(fl,solution[ij],','); write(fl,solution[i,VertQuantity[i]]); writeln(fl);

end; end;

writeln(fl,'Суммарная длина маршрутов J1 = ',sumlen); writeln(fl,'Длина максимального маршрута J2 = ',maxlen); writeln(fl,'Значение критерия качества = ',svertka:4:3); comb:=nil; a:=nil;

ActiveMen:=nil;

mas:=nil;

copymas:=nil;

solution:=nil;

VertQuantity:=nil;

lens:=nil;

sol:=nil;

VertSol:=nil;

lenssol:=nil;

FinishTime.-Now;

writeln(fl /Время работы программы:',

FormatDateTime(h:mm:ss',FinishTime-StartTime));

close(fl); end.

3. Реализация эвристического алгоритма.

program HeuristicAlg; {SAPPTYPE CONSOLE} uses

SysUtils;

const RealValue=l. 1E+305; var

StartTime,FinishTime:TDateTime; s,sq,w,n,ij, iter, Maxlter,maxcycle, maximum, min:integer; 01dOrNew,P,ChooseAlg:integer; alpha l,alpha2:real; svertka,svertkal extended; sumlen 1 ,maxlen 1 ,sumlen,maxlen:integer; cycles,solution,mas:array of array of integer; RandomPermutation,Quantity,SolQuantity,SNumbs, len:array of integer;

fl :text;

Procedure RandomVector(size:integer;var rv.array of integer); var

e,f,temp:integer; rand01num:real; y,b:integer; begin

for e:=l to size do rv[e]:=e;

for f:=0 to size-1 do begin

randO 1 num~(random(99)+1 у 100;

y:=trunc(randO 1 num*(size-f)+1); b:=y+f; temp:=rv[b]; rv[b]:=rv[f+l]; rv[f+l]:=temp; end; end;

procedure GenerateQuantity(CurrentS:integer); var

e,f,rn,temp:integer; IsPresent:boolean; TempArray:array of integer; begin

SetLength(TempArray,CurrentS+1); for e:=l to s do Quantity[e]:=0; TempArray[0]:=0; TempArray[CurrentS] :=n; if CurrentS>l then begin

for e:=l to Currents-1 do begin repeat rn:=Random(n-l)+l; IsPresent:=false; for f:=0 toe-ldo if TempArray[f]=rn then begin

IsPresent:=true; break; end;

until not IsPresent; TempArray[e]:=rn; end;

f:=(CurrentS+l) div 2; while (fi>=l) do begin

for e:=CurrentS-f downto 1 do begin

if TempArray[e]>TempArray[e+f] then begin

Temp:=TempArray[e]; TempArray[e]:=TempArray[e+f]; TempArray [e+f] :=Temp; end; end; f:=f-l; end;

end; {CurrentS>l} for e:=l to Currents do

Quantity[SNumbs[e]] :=TempArray [e]-TempArray[e-1 ]; TempArray:=nil;

end;

procedure FormCycles; var

e,f,u:integer; begin for e:=l to s do for f:=l to n+4 do cycles[e,f]:=0; u-0;

fore:=l to wdo if Quantity[SNumbs[e]]X) then begin

for f:=l to Quantity[SNumbs[e]] do begin u:=u+l;

cycles[SNumbs[e],f]:=RandomPermutation[u]; end;

cycles[SNumbs[e],Quantity[SNumbs[e]]+l]:= cycles[SNumbs[e],n+5];

end; end;

procedure FormNearest(rv:array of integer); var

e,f,u,v,FoundVertex,minimum:integer; begin

for e:=l to s do for f:=l to n+4 do cycles[e,f]:=0; fore:=l to wdo if Quantity[SNumbs[e]]>0 then begin

FoundVertex:=cycles[SNumbs[e],0]; for f:=l to Quantity[SNumbs[e]] do begin

minimum:=maximum+1; foru:=l ton do

if (minimum>mas[FoundVertex,u])and(FoundVertex<>u)and(rv[u]>0) then begin

minimum:=mas[FoundVertex,u]; v:=u; end; FoundVertex:=v; rv[Found Vertex] :=-1; cycles[SNumbs[e],f] :=FoundVertex; end;

cycIes[SNumbs[e],Quantity[SNumbs[e]]+l]:= cycles[SNumbs[e],n+5];

end;

end; { procedure FormNearest }

procedure GetLens;

var