13. " : . .- .: .-., 2003.- , 928.
14. , : . ./ .. . - ,: " ", 2004.-292c.
15. : / .. //. ., "", 11, 2002, . 49-52.
16. " " ( " -" ()). ., " ", 4, 1999, . 43-47.
17. 21 : ./ .. // ., , 2000 . 14-47.
18. " "/ .. ., ": , , ", 7, 1998, . 3-18.
19. " "./. // ., "", 9, 1997, . 84-87.
20. . ., -, 2003, . 57-68, 78-81.
21. , Delphi 7. ./ . . . .: , 2004. 736 .
22. , Delphi . / . . . .: - , 2006. 288
23. Delphi. URL: http://personal.primorye.ru/docjohn/ faq/obsh.htm.
Program Salesman_Tour;
{epebop}
Uses CRT;
Const n=8;{ }
var
Summ: LongInt;
MinSumm: LongInt;
i,k,j: Integer;
Towns: array[0 n+1] of Integer;
ResTour: array[0 n+1] of Integer;
Dist: array [0 n+1,0 n+1] of Integer;
Count: LongInt;
prg: Real;
ToEstimate: Real;
Points: array[0 n] of Record
x,y: Integer; end;
Procedure FillDist;
Var ix,iy: Byte; dx,dy: LongInt;
Begin
For iy:=1 to n do for ix:=1 to n do begin
{if ix=iy Then begin Dist[ix,iy]:=0; Continue; end;{}
dx:=Points[ix].x-Points[iy].x;
dy:=Points[ix].y-Points[iy].y;
Dist[ix,iy]:=Round(Sqrt(dx*dx+dy*dy));
end;
for iy:=1 to n do Towns[iy]:=iy;
end;
Procedure ReadFromFile;
Var DFile: Text; k: Integer; X,Y,t: String[1];
begin
Assign(DFile,'D:\DPoints.dat');
Reset(DFile);
for i:=1 to n do begin
read(DFile,X); Val(X,Points[i].X,k); Read(DFile,t);
read(DFile,Y); Val(Y,Points[i].Y,k); Read(DFile,t);
end;
Close(DFile);
end;
Procedure WriteTour;
Var k: Integer;
begin
for k:=1 to n do Write(Towns[k],'-');
Writeln;
end;
Function Min(Val1,Val2: Integer): Integer;
begin
If Val1>Val2 Then Min:=Val1 else Min:=Val2;
end;
Function GetMinInd(I0,iMin: Integer): Integer;
Var i,Ind: Integer;
begin
Ind:=I0;
For i:=I0 to N do
If (Towns[i]
GetMinInd:=Ind;
end;
Procedure Exchange(Ind1: Integer; Ind2: Integer);
Var Temp: Integer;
begin
Temp:=Towns[Ind1]; Towns[Ind1]:=Towns[Ind2]; Towns[Ind2]:=Temp;
end;
Procedure Sort(j: Integer);
{ j }
var i,k,Ind,Min{}: Integer;
begin
For i:=j to n do begin
Ind:=Towns[j];
Min:=32000;{}
For k:=i to n do
If Towns[k] Ind:=k; Min:=Towns[k];{}
{Ch:=True;{}
end;
Exchange(Ind,i);
end;
end;
Procedure SetNextRote2;
var i: Integer;
begin
For i:=n downto 1 do begin
If Towns[i]>Towns[i-1] Then begin
Exchange(i-1,GetMinInd(i,i-1));
sort(i);
Exit;{Break;{}
end;
end;
end;
Function Fact(N: Integer): Real;
Begin
If n<>0 Then Fact:=n*Fact(n-1)
else Fact:=1;
end;
begin
ClrScr;
TextColor(14);
Summ:=0;
MinSumm:=2000000000;
ReadFromFile;
FillDist;
{InitTowns;{}
ToEstimate:=Fact(n-1);
WriteLn('a Escape ');
While Count Summ:=0;
For i:=1 to n-1 do
Summ:=Summ+Dist[Towns[i],Towns[i+1]];
Summ:=Summ+Dist[Towns[n],Towns[1]];
If MinSumm>Summ Then begin
MinSumm:=Summ;
For k:=1 to n do
ResTour[k]:=Towns[k];
end;
SetNextRote2;
Inc(Count);
Prg:=(Count/ToEstimate*100);{}
Write(' : ',MinSumm,' : ',prg:3:1,
'%'{,ToEstimate:4);
For I:=1 to Round(prg*0.41) do Write(#219);{}
Write(#13);
If (KeyPressed) and (Readkey=#27) then halt;{}
end;
WriteLn(#7);
WriteLn(' : ');
For k:=1 to n do
Write(ResTour{}[k],'-');
WriteLn(ResTour[1]);
WriteLn(' : ');
WriteLn(MinSumm);
Repeat Until KeyPressed;
end. Allbest.ru