Кадура (Математическое моделирование процессов перевозки грузов железнодорожным транспортом на основе использования задачи коммивояжера), страница 15
Описание файла
Файл "Кадура" внутри архива находится в папке "Математическое моделирование процессов перевозки грузов железнодорожным транспортом на основе использования задачи коммивояжера". Документ из архива "Математическое моделирование процессов перевозки грузов железнодорожным транспортом на основе использования задачи коммивояжера", который расположен в категории "". Всё это находится в предмете "дипломы и вкр" из 8 семестр, которые можно найти в файловом архиве ДВГУПС. Не смотря на прямую связь этого архива с ДВГУПС, его также можно найти и в других разделах. .
Онлайн просмотр документа "Кадура"
Текст 15 страницы из документа "Кадура"
e,f:integer;
begin for e:=l to s do len[e]:=0;
for e:=l to wdo if Quantity [SNumbs[e]]>0 then for f:=0 to Quantity[SNumbs[e]] do len[SNumbs[e]]:=len[SNumbs[e]]+
mas[cycles[SNumbs[e],f],cycles[SNumbs[e],f+l]];
end;
procedure GetSumLen; var e:integer; begin
sumlenl:=0; fore:=l to wdo
sumlenl:=sumlenl+len[SNumbs[e]]; end;
procedure GetMaxLen(var mc:integer); var e:integer; begin maxlenl:=0; for e:=l to w do
if maxlenl<len[SNumbs[e]] then begin
maxlenl:=len[SNumbs[e]]; mc:=SNumbs[e]; end; end;
procedure MemorizeCurrentSolution;
var e,f:integer;
begin
{Зануление решения} for e:=l to s do for f:=0 to n+5 do solution[e,f]:=0; for e:=l to s do begin
SolQuantity[e] :=Quantity[e]; for f:=0 to n+5 do solution[e,f]:=cycles[e,f]; end; end;
procedure AIg2; var
e,f,u,nfV,temp,lencycle:integer; delta,r_new,r_old,r_newl ,r_new2,r_oldl ,r_old2:integer; begin
foru:=l to wdo if Quantity[SNumbs[u]]>2 then begin repeat
lencycle:=len[SNumbs[u]];
for e:=l to Quantity[SNumbs[u]]-2 do begin delta:=0;
for f:=e+2 to Quantity[SNumbs[u]] do begin
r_newl:=mas[cycles[SNumbs[u],e-l],cycles[SNumbs[u],f]]+
mas[cycles[SNumbs[u],f],cycles[SNumbs[u],e+l]j; r_new2:=mas[cycles[SNumbs[u],f-l],cycles[SNumbs[u],e]]+
mas[cycIes[SNumbs[u],e],cycles[SNumbs[u],f+l]j; r_new:=r_newl+r_new2;
r_oldl:=mas[cycles[SNumbs[u],e-l],cycles[SNumbs[u],e]]+ mas[cycIes[SNumbs[u],e],cycles[SNumbs[u],e+l]]; r_old2:=mas[cycles[SNumbs[u],f-l],cycles[SNumbs[u],f]]+ mas[cycIes[SNumbs[u],f],cycles[SNumbs[u],f+l]j; r_old:=r_oldl+r_old2;
if r_new-r_old<delta then begin
delta:=r_new-r_old; nfv:=f; end; end;
if delta<0 then begin
temp:=cycles[SNumbs[u],e]; cycles[SNumbs[u],e]:=cycles[SNumbs[u],nfv]; cycles[SNumbs[u],nfV]:=temp; len[SNumbs[u]]:=Ien[SNumbs[u]]+delta; end; end;
until lencycle=len[SNumbs[u]]; end; end; {Alg2}
procedure Alg3; var
e,f,u,v,nfv,lencycle:integer;
delta,r_new,r_old,r_newl,r_new2,r_oldl,r_old2:integer; begin
foru:=l to wdo if Quantity[SNumbs[u]]>l then repeat {begin}
lencycle:=len[SNumbs[u]]; for e:=l to Quantity[SNumbs[u]]-l do begin delta:=0;
for f:=e+l to Quantity[SNumbs[u]] do begin
r_newl:=mas[cycles[SNumbs[u],e-l],cycles[SNumbs[u],e+l]]+
mas[cycles[SNumbs[u],fI,cycIes[SNumbs[u],e]]; r_new2:=mas[cycles[SNumbs[u],e],cycles[SNumbs[u],f+l]]; r_new:=r_newl+r_new2;
r_oldl:=mas[cycles[SNumbs[u],e-l],cycles[SNumbs[u],e]]+
mas[cycles[SNumbs[u],e],cycles[SNumbs[u],e+l]]; r_old2:=mas[cycles[SNumbs[u],f],cycles[SNumbs[u],f+l]]; r_old:=r_oldl +r_old2;
if r_new-r_old<delta then begin
delta:=r_new-r_old; nfV:=f; end; end;
if delta<0 then begin
for v:=Quantity[SNumbs[u]]+l downto nfv do cycles[SNumbs[u],v+l]:=cycles[SNumbs[u],v]; cycles[SNumbs[u],nfv+l]:=cycles[SNumbs[u],e]; for v:=e to Quantity[SNumbs[u]]+2 do cycles[SNumbs[u],v]:=cycles[SNumbs[u],v+l]; len[SNumbs[u]]:=len[SNumbs[u]]+delta; end; end;
until lencycle=len[SNumbs[u]]; { end;}
end; {Alg3 }
procedure Alg4; var
e,f,u,niVl ,nfv2:integer;
GetNew,Get01d,PutNew,Put01d, delta, deltaPut: integer; PutToOther,FoundInMax:boolean; begin if w>l then begin nfVl:=l;
PutToOther:=false; GetMaxLen(maxcycle); if Quantity [maxcycle]>l then repeat
FoundInMax:=false; u:=nfVl-l; repeat u.-u+l;
GetNew:=mas[cycles[maxcycle,u-l],cycles[maxcycle,u+l]]; Get01d:=mas[cycles[maxcycle,u-l],cycles[maxcycle,u]]+ mas[cycles[maxcycle,u],cycles[maxcycle,u+l]]; until (u=Quantity[maxcycle])or(GetNew-Get01d<0); if GetNew-Get01d<0 then begin nfVl:=u;
FoundInMax:=true; end;
if FoundInMax=true then begin
PutToOther:=false;
е:=0; repeat е:=е+1;
if SNumbs[e]omaxcycle then begin delta:=0;
for f:=0 to Quantity[SNumbs[e]] do begin
PutNew:=mas[cycles[SNumbs[e],f],cycles[maxcycle,nfVl]]+ mas[cycles[maxcycle,nfVl],cycles[SNumbs[e],f+l]j; Put01d:=mas[cycles[SNumbs[e],f],cycles[SNumbs[e],f+l]]; if (GetNew-Get0Id+PutNew-Put01d)<delta then begin
de!taPut:=PutNew-PutOId; delta:=GetNew-Get01d+deltaPut; nfV2:=f; end; end; if delta<0 then begin
PutToOther:=true;
for u:=Quantity[SNumbs[e]]+l downto nfv2+l do cycles[SNumbs[e],u+1 ] :=cycles[SNumbs[e] ,u]; cycles[SNumbs[e],nfV2+l]:=cycles[maxcycle,nfvl]; for u:=nfVl to Quantity[maxcycle]+2 do cycles[maxcycle,u]:=cycles[maxcycle,u+l]; len[maxcycle]:=len[maxcycle]+GetNew-Get01d; len[SNumbs[e]]:=len[SNumbs[e]]+deltaPut; Quantity[maxcycle]:=Quantity[maxcycle]-l; Quantity[SNumbs[e]]:=Quantity[SNumbs[e]]+1; end;
end; {SNumbs[e]omaxcycle} until (PutToOther=true)or(e=w); end; {FoundInMax=true} if PutToOther=true then begin nfvl:=l;
GetMaxLen(maxcycle); end
else nfVl:=nfvl+l; until (nfvl=Quantity[maxcycle]+l)or
(FoundInMax=false)or(Quantity[maxcycle]=l); end; {if w>l } end; {Alg4} begin
StartTime:=Now;
rewrite(output);
randomize;
{ writeln('3HK: Комбинация эвристик'); }
assign(fl,'test.txt');
reset(fl);
read(fl,n); {Количество городов }
read(fl,s); { Количество коммивояжеров}
read(fl,sq); {0 - фиксированное количество коммивояжеров (<=n), 1 - оптимальное} read(fl,alphal,alpha2); {Показатели важности } SetLength(mas,n+2*s+1 ,n+2*s+1); SetLength(cycles,s+1 ,n+7); SetLength(solution,s+1 ,n+7); SetLength(SNumbs,s+1); SetLength(Quantity,s+1); SetLength(len,s+l); SetLength(SolQuantity,s+1); SetLength(RandomPermutation,n+1); for i:=l to n+2*s do begin
for j:=l to n+2*s do read(fl,mas[ij]); readln(fl); end;
close(fl);
assign(fl,'IterNum.txt'); reset(fl); read(fl,MaxIter); close(fl);
if s>n then min:=n else min:=s; maximum:=0; for i:=l to n+2*s do for j:=l to n+2*s do
if maximum<mas[ij] then maximum:=mas[i j]; for i:=l to s do for j:=0 to n+5 do cycles[ij]:=0; i:=l; j:=0; while i<2*s do begin
cycles[j,0]:=n+i; cycles[j,n+5]:=n+i+l; i:=i+2; end;
svertka:=RealValue; iter:=0;
OldOrNew-lOOO; while iter<MaxIter do begin iter:=iter+l; if OldOrNew>500 then begin
if sq=0 then w:=min else w:=random(min)+l;
Random Vector(s,SNumbs);
GenerateQuantity(w);
Random Vector(n,RandomPermutation);
P:=random(1000)+-1;
if P>700 then FormNearest(RandomPermutation)
else FormCycles; end { if 01dC)rNew>500 } else begin
ChooseAlg:=random( 1000)+1; if(ChooseAlg>0)and(ChooseAlg<=300) then Alg2 else
if (ChooseAlg>300)and(ChooseAlg<=600) then Alg3 else Alg4
end; GetLens; GetSumLen; GetMaxLen(maxcycle);
svertkal:=exp(alphal*ln(sumlenl))*exp(alpha2*ln(niaxlenl)); if svertkal<svertka then begin iter:=0;
sumlen:=sumlenl; maxlen:=maxlenl; svertka:=svertkal; MemorizeCurrentSolution; end;
C)ldOrNew:=random(1000)+1; end; {iter} assign(fl,'HeurOutput.txt'); rewrite(fl);
writeln(fl,'3HK: эвристический алгоритм'); writeln(fl количество городов n = ',n); writeln(fl,Количество коммивояжеров s = ',s); writeln(fl .Размер матрицы n+2*s = ',n+2*s); writeln(fl,'Решение задачи:');
for i:=l to s do begin
if SolQuantity[i]>0 then begin
write(fl,i,')');
for j:=0 to SolQuantity[i] do write(fl,solution[ij],','); write(fl ,solution[i,SolQuantity[i]+1 ]); writeln(fl); end; end;
writeln(fl,'Суммарная длина маршрутов J1 = ',sumlen);
writeln(fl,'Длина максимального из маршрутов J2 = ',maxlen);
writeln(fl,'Значение критерия качества = ',svertka:4:3);
mas:=nil;
cycles:=nil;
solution:=nil;
SNumbs:=nil;
Quantity:=nil; len:=nil;
SolQuantity:=nil;
RandomPermutation:=nil;
FinishTime:=Now;
writeln(fl,'Время работы программы:
FormatDateTime('h:mm:ss',FinishTime-StartTime));
close(fl); end.
21