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]<Towns[I0]) and (Towns[i]>iMin) then Ind:=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]<Min{Towns[Ind]{} Then begin
         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<ToEstimate do begin
   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.