Кадура (1194486), страница 13

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 13)

Тексты программ на Borland Delphi 7.

1. Реализация метода полного перебора.

program FullAnalyze; (SAPPTYPE CONSOLE} uses

SysUtils;

const RealValue=l ЛЕ+305; var

StartTime,FinishTime:TDateTime;

s,n,sq₅min,m,ij,L,w,sumlen,maxlen:integer;

z,y:int64;

alphal,alpha2:real; svertka:extended;

cycles,solution:array of array of integer; mas:array of array of integer;

Quantity, SolQuantity,sa,sb,pl,p2,aforn,afors,p:array of integer; fl :text;

procedure calc; var e,f:integer; sumlenl,maxlenl:longint; svertkal:extended; Ienl:array of integer; begin

SetLength(lenl,s+l); for e:=l tosdo lenl[e]:=0; for e:=l to s do if Quantity [e]>l then for f:=l to Quantity[e]-1 do len 1 [e] :=lenl [e]+mas[cycles[e,f],cycles[e,f+1 ]]; for e:=l to s do if Quantity[e]>0 then len 1 [e] :=len 1 [e]+mas[sa[e],cycles[e, 1 ]]

+mas[cycles[e,Quantity[e]],sb[e]];

sumlenl:=0; for e:=l to s do sumlen 1 :=sumlen 1+len 1 [e]; maxlenl:=0; for e:=l to s do if maxlenl<lenl[e] then maxlenl:=lenl[e]; svertka 1 :=exp(alpha 1 *ln(sumlen 1 ))*exp(alpha2*ln(maxlen 1)); if svertkal<svertka then begin

sumlen:=sumlenl; maxlen:=maxlenl; svertka:=svertkal;

fore:=l tosdo begin

SolQuantity[e] :=Quantity[e]; for f:=l to n do solution[e,f]:=cycles[e,f]; end; end;

lenl:=nil; end; {calc}

procedure formcycles; var e,f,g: integer; begin

for e:=l to s do Quantity[e]:=0; g~0;

fore:=l to wdo begin

Quantityfpl [e]]:=p2[e]-g; g:=p2[e]; end; g:=0;

fore:=l tosdo if Quantity[e]>0 then for f:=l to Quantity[e] do begin g:=g+U

cycles[e,f]:=p[g]; end; calc; end;

procedure cnk2(n,k:integer); procedure gen(m,L:integer); var e,u,v: integer; begin

if m=0 then begin

p2[k+l]:=n+l; formcycles; for u:=l to s do forv:=l to n+1 do cycles[u,v]:=0;

end else

for e:=L to n-m+1 do begin p2 [k-m+1 ] :=aforn [e]; gen(m-l,e+l); end; end; {gen} begin {cnk2} gen(k,l); end;{cnk2}

procedure cnkl(s,k:integer); procedure gen(m,L:integer); var e:integer; begin

if m=0 then begin

cnk2(n-l,k-l); end else

for e:=L to s-m+1 do begin

pl[k-m+l]:=afors[e]; gen(m-l,e+l); end; end; {gen} begin {cnkl} gen(k,l); end; {cnkl} begin

StartTime:=Now; rewrite(output);

{Разомкнутая задача нескольких коммивояжеров (полный перебор)}

assign(fl,'test.txt');

reset(fl);

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

read(fl ,alphal ,alpha2); SetLength(mas,n+2*s+l,n+2*s+l); for i:=l to n+2*s do begin

forj:=l ton+2*s do read(fl,mas[ij]); readln(fl); end;

close(fl); SetLength(sa,s+l); SetLength(sb,s+l); i:=l;j:=0; while i<2*s do begin j:=j+i; sa[j]:=n+i; sb[j]:=n+i+l; i:=i+2; end;

SetLength(Quantity,s+1); SetLength(SolQuantity,s+1); SetLength(cycles,s+1 ,n+1); SetLength(solution,s+1 ,n+1); SetLength(p,n+l); SetLength(aforn,n+1);

SetLength(afors,s+1); for i:=l to n do begin

p[i]:=n-i+l; aforn[i]:=i; end;

for i:=l to s do afors[i]:=i; svertka:=RealValue; SetLength(pl,s+l); SetLength(p2,n+l); if s>n then min:=n else min:=s; if sq=0 then sq:=min else sq:=l; 2-1; y~i;

while y<n do

begin

y:=y+l;

z:=z*y;

end;

for w:=sq to min do cnkl(s,w);

y:=i;

while y<z do begin

y:=y+i; i:=2; j:=l;

while p[i-l]<=p[i] do

i:=i+l;

while p[j]^<=p[i] do j:=j+i;

m:=p[i];p[i]:=p[j];pD]:⁼m;

for L:=l to((i-l)div 2) do begin

m:=p[L] ;p[L] :=p[i-L];p[i-L] :=m; end;

for w:=sq to min do cnkl(s,w); end;

assign(fl ,'FullOutput.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,') ',sa[i],',');

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

writeln(fl,'Суммарная длина маршрутов J1 = ',sumlen);

writeln(fl/Длина максимального из маршрутов J2 =',maxien);

writeln(fl,'Значение критерия качества = ',svertka:4:3);

mas:=nil;

sa:=nil;

sb:=nil;

Quantity:=nil;

SolQuantity:=níI;

cycles:=nil;

solution:=nil;

p:=nil;

aforn:=nil;

afors:=nil;

pl:=nil;

p2:=nil;

FinishTime:=Now;

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

FormatDateTime('h:mm:ss',FinishTime-StartTime)); close(fl); end.

2. Реализация метода, использующего деревья поиска.

program TSSPTrees; {SAPPTYPE CONSOLE} uses

SysUtils; const

nmax=80;

BigValue=l 000000000; RealValue=l. 1E+305; type

TwoDimArray=aiTay of array of integer; VariablesOnNode=record done:boolean; H:integer; svLim:extended; dim:integer; QFormedPaths:integer; QDisableRibs:integer; end;

pVariabIesOnNode=^AVariablesOnNode; BTreeVariables=array[1..2*nmax*nmax] of pVariablesOnNode;

ArraysOnNode=record dir,rev,indi,indj:array of integer; consti,constj:array of integer;

DisableRibsBeg.array of integer; DisableRibsEnd:array of integer; end;

BTreeArrays=array[1..2*nmax*nmax] of ArraysOnNode; var

StartTime,FinishTime:TDateTime;

n,s,sq,m,min,ij,IsEven:integer;

sumlen,maxien: integer;

alphal,alpha2:real;

svertka:extended;

GetZero,Reduction:boolean;

a,comb,ActiveMen:array of integer;

lens,lenssol:array of integer;

VertQuantity,VertSol:array of integer;

Solution,sol:array of array of integer;

mas,copymas:TwoDimArray; { матрица расстояний }

fl:text;

procedureNewNode(index:integer;varVariablesStruct:BTree Variables; var ArraysStruct:BTreeArrays);

begin

new(VariablesStruct[index]); SetLength(ArraysStruct[index] ,dir,n+2*s+1); SetLength(ArraysStruct[index].rev,n+2*s+l); SetLength( Array sStructfindex]. indi,n+2 *s+1); SetLength( Array sStruct [index]. indj ,n+2 *s+1); SetLength(ArraysStruct[index].consti,n+2*s+1); SetLength(ArraysStruct[index].constj,n+2*s+1); SetLength(ArraysStruct[indexj.DisableRibsBeg,s+1); SetLength(ArraysStruct[indexj.DisableRibsEnd,s+1); end;

procedureInitNode(index,previndex:integer;varVariablesStruct:BTree Variables; var ArraysStruct:BTreeArrays);

var e:integer; begin

VariablesStmct[index]^A.done:=VariablesStruct[previndex]^A.done;

VariablesStruct[index]^A.H:=VariablesStruct[previndex]^A.H;

VariablesStruct[index]^A.svLim:=VariablesStruct[previndex]^A.svLim;

VariablesStruct[index]^A.dim:=VariablesStruct[previndex]^A.dim;

VariablesStruct[index]^A.QFormedPaths:=VariablesStruct[previndex]^A.QFormedPaths;

VariablesStruct[index]^A,QDisableRibs:=0;

fore:=l ton+2*s do

begin

ArraysStruct[index].dir[e]:=ArraysStruct[previndex].dir[e]; ArraysStruct[index] ,rev[e] :=ArraysStruct [previ ndex]. rev[e]; ArraysStruct[index].indi[e]:=ArraysStruct[previndex].indi[e]; ArraysStruct[index].indj[e]:=ArraysStruct[previndex].indj[e]; ArraysStruct[index].consti[e]:=ArraysStruct[previndex].consti[e]; ArraysStruct[index].constj[e]:=ArraysStruct[previndex].constj[e]; end;

for e:=l to s do begin

ArraysStruct[index].DisableRibsBeg[e]:⁼0; ArraysStruct[index].DisableRibsEnd[e]:⁼0; end; end;

Procedure DisposeNode(index:integer;varVariablesStruct:BTreeVariables; var ArraysStruct:BTreeArrays);

begin

dispose(VariablesStruct[index]);

ArraysStruct[index].dir:=nil;

ArraysStruct[index].rev:=nil;

ArraysStruct[index].indi:=nil;

ArraysStruct[index].indj :=nil;

ArraysStruct[index].consti:=nil;

ArraysStruct[index].constj:=nil;

ArraysStruct[index].DisableRibsBeg:=nil;

ArraysStruct[index].DisableRibsEnd:=nil;

end;

procedure ReductAndGetZero(matrix:TwoDimArray;var svH:extended;var sumH.founde, foundf:integer;var ConstRow,ConstColumn,IndRow,IndColumn:array of integer); var e,f,value,mine,minf,SumMineAndf,columne,rowf:integer; RowBigValue,ColumnBigValue:boolean; Hrows,Hcolumns:array of integer; matr:array of array of integer; begin

SetLength(matr,n+2*s+1 ,n+2*s+1); fore:=l ton+2*s do for f:=l to n+2*s do matr [e,fj :=matrix[e,f]; fore:=l ton+2*s do if IndRow[e]>0 then for f:=l to n+2*s do if (IndColumn[f]>0)and(matr[e,f]<BigValue) then matr[e,f] :=matr[e,f]-ConstRow[e]; {Вычитаем минимум из столбцов } for е:=1 to n+2*s do if IndColumn[e]>0 then for f:=l to n+2*s do if (IndRow[f|>0)and(niatr[f₅e]<BigValue) then

matr[f,e] :=matr[f,e]-ConstCol umn[e];

if Reduction=true then begin

SetLength(Hrows,n+2*s+1); SetLength(Hcolumns,n+2*s+1); for e:=l to n+2*s do begin

Hrows[e]:=0; Hcolumns[e]:=0; end;

for e:=l to n+2*s do if IndRow[e]>0 then

begin

Hrows[e]:=BigValue; for f:=l to n+2*s do

if (IndColumn[i]>0)and(Hrows[e]>matr[e,f]) then Hrows[e]:=matr[e,f];

end;

RowBigValue:=false; for e:=l to n+2*s do if Hrows[e]=BigValue then begin

RowBigValue:=true; break; end;

fore:=l ton+2*s do if IndRow[e]>0 then for f:=l to n+2*s do

if (IndColumn[f]>0)and(matr[e,f]<BigValue) then matr[e,f] :=matr[e,f]-Hro ws[e]; if RowBigValue=true then sumH:=BigValue; if sumH<BigValue then for e:=l ton+2*s do sumH:=sumH+Hrows[e]; fore:=l ton+2*s do

if Hrows[e]=BigValue then ConstRow[e]:=BigValue else

if ConstRow[e]<BigValue then

ConstRow[e]:=ConstRow[e]+Hrows[e]; for e:=l to n+2*s do if IndColumn[e]>0 then begin

Hcolumns[e]:=BigValue; for f:=l to n+2*s do

if(IndRow[f]>0)and(Hcolumns[e]>matr[f,e])then Hcolumns[e] :=matr[f,e];

end;

ColumnBigValue:=false; fore:=l ton+2*s do if Hcolumns[e]=BigValue then begin

ColumnBigVaIue:=true; break; end;

fore:=l ton+2*s do if IndColumn[e]>0 then for f:=l to n+2*s do

if(IndRow[f]>0)and(matr[f,e]<BigValue) then matr[f,e]:=matr[f,e]-Hcolumns[e]; if ColumnBigValue=true then sumH:=BigValue; if sumH<BigValue then fore:=l ton+2*s do sumH:=sumH+Hcolumns[e]; for e:=l to n+2*s do

if Hcolumns[e]=BigValue then ConstColumn[e]:=BigValue else

if ConstColumn[e]<BigValue then

ConstColumn[e]:=ConstColumn[e]+Hcolumns[e]; if sumH=0 then svH:=0.00001; if sumH>=BigValue then svH:=RealValue; if (sumH>0)and(sumH<BigValue) then

svH:=exp(alphal*ln(sumH))*(exp(aIpha2*ln(sumH))/exp(alpha2*ln(m))); Hrows:=nil; Hcolumns:=nil; end; {Reduction} if GetZero=true then begin

value:=-l; founde:=-l; foundf:=-l; for e:=l to n+2*s do if IndRow[e]>0 then for f:=l to n+2*s do

if (IndCoIumn[f]>0)and(matr[e,f)=0) then begin

mine:=BigVaIue; for columne:=l to n+2*s do if(IndColumn[columne]>0)and(columneof)and(matr[e,columne]<mine) then mine:=matr[e,columne]; minf:=BigValue; for rowf:=l to n+2*s do if (IndRow[rowf|>0)and(rowfoe)and(matr[rowf,i]<minf) then minf:=matr[rowf,f]; if (mine=BigValue)or(minf=BigValue)or(mine+minf>BigValue) then SumMineAndf:=BigValue else SumMineAndf:=mine+minf; if value<SumMineAndf then begin

value:=SumMineAndf; founde:=e; foundf:=f; end;

end; {if (IndColumn[f|>0)and(matr[e,f]=0)}

end; {GetZero}

matr:=nil;

end;

procedure GetPath(direct,reverse:array of integer;founde,foundf:integer; varvl,v2:integer);

begin

vl:=foundf; while direct[vl]>0 do vl:=direct[vl]; v2:=founde; while reverse[v2]>0 do v2:=reverse[v2]; end;

procedure BnBMethod(combination:array of integer); var

TreeArrays:BTreeArrays; Tree Variables:BTree Variables; Treelndiinteger; e,f,k:integer;

sumlen 1 ,maxlen 1 .integer; svertkal extended; x,y,p,q:integer; begin

Treelnd:=l;

NewNode(TreeInd,Tree Variables,TreeArrays);

TreeVariables[TreeInd]^A.done:=false;

TreeVariables[TreeInd]^A.H:=0;

TreeVariables[TreeInd]^A.svLim:=0;

TreeVariables[TreeInd]^A.dim:=n+m;

TreeVariables[TreeInd]^A.QFormedPaths:=0;

TreeVariables[TreeInd]^A.QDisableRibs:⁼0;

fore:=l ton+2*s do

Характеристики

Список файлов ВКР