Program Salesman_Tour;
{мой метод решения зк}
Uses Graph,Crt;

Const
 OutDist=false{true{}; OutGraph=true; none=255;{Пусто}
 {>>}n=9;{количество городов}
 MaxCx=400; MaxCy=400;{Максимальные координаты городов на плоскости} xwr=32;
 prop='Для нового просчёта нажмите ENTER, для выхода - любую другую клавишу';

Var
 d,m: Integer;{графический режим}
 Points: array[0..n] of PointType;{координаты точек}
 Towns: array[0..n+1] of Byte;{конечный тур}
 Dist: array[0..n,0..n] of LongInt;{матрица расстояний}
 Central: array[0..n] of Boolean;{инидикатор центрального города}
 a,b: Byte;{Коэффициенты в уравнении прямой}
 ct: Byte;{количество центральных городов, не лежащих на выпуклом многоугольнике}
 wx,wy: Integer;{текущие координаты печати}
 TIP: Byte;{TIP = TownsInPolygon - количество городов лежащих на периметре
 выпуклого многоугольника}

Procedure ReadFromFile;
Var DFile: Text; i,k: Integer; sX,sY,t: String[1];
begin
  Assign(DFile,'D:\DPoints.dat');
  Reset(DFile);
  for i:=1 to n do With Points[i] do begin
    read(DFile,sX);  Val(sX,X,k);   Read(DFile,t); X:=X*10+200;
    read(DFile,sY);  Val(sY,Y,k);   Read(DFile,t); Y:=Y*10+200;
  end;
  Close(DFile);
end;

Procedure SetPointCoord;
Var i: Byte;
begin ReadFromFile;
{Randomize;
For i:=0 to n-1 do With Points[i] do begin
  x:=Random(MaxCx)+638-MaxCx;
  y:=Random(MaxCy)+478-MaxCy;
end;
Points[n]:=Points[0];{}
end;

Procedure PutPoints;
Var I,c: Byte; x,y: Integer; s: string;
Begin
c:=GetColor;
for i:=1 to n do begin
 x:=Points[i].x; y:=Points[i].y;
 Circle(x,y,2);
 str(i,s);
 SetColor(10);
 OutTextXY(x-9,y-9,s);
 SetColor(c);
end;
end;

Procedure Init;
begin
 FillChar(Dist,SizeOf(Dist),0);
 {Обнуление расстояний между городами}
 FillChar(Central,Sizeof(Central),true);
 FillChar(Towns,SizeOf(Towns),none);
 {Обнуление массива с индексами центральных городов и массива с индексами
 городо, входящих в оптимальный тур}
 ct:=n; wx:=0; wy:=0; TIP:=0;
 FillChar(mem[$A000:0],64000,0);{очистка экрана}
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;
end;

Function EstimateTour: Word;
{Возвращает длину тура, записанного в массиве Towns[..]}
var i: byte; res: word;
begin
 for i:=1 to n-1 do Inc(res,Dist[i,i+1]);
 Inc(res,Dist[n,1]); EstimateTour:=res;
end;

Procedure Show(S: String);
begin
  OutTextXY(wx,wy,s);
  wx:=wx+Length(s)*8;
end;

Procedure ShowLn(S: String);
begin
  OutTextXY(wx,wy,s);
  wx:=0;  Inc(wy,9);
end;

Function IntToStr(i: Integer): String;
var t: string; begin Str(i,t); IntToStr:=t; end;

Procedure PutDist;
{Выводит на экран расстояние между городами рядом с ребром графа этой длины}
var ix,iy,c: Byte; tx,ty: Integer;
begin
 c:=GetColor; SetColor(1);
 for iy:=1 to n do for ix:=1 to n do begin
   tx:=(Points[ix].x+Points[iy].x) div 2;
   ty:=(Points[ix].y+Points[iy].y) div 2;
   OutTextXY(tx+9,ty+9,IntToStr(Dist[ix,iy]));
 end;
 SetColor(c);
end;

Procedure Connect(i1,i2: Byte);
begin Line(Points[i1].x,Points[i1].y,Points[i2].x,Points[i2].y); end;

Procedure Disconnect(i1,i2: Byte);
var c: byte;
begin
 c:=GetColor; SetColor(1);
 Line(Points[i1].x,Points[i1].y,Points[i2].x,Points[i2].y);
 setcolor(c);
end;

Procedure BGraph;
{Построение планарного графа тёмным, неактивныи цветом}
var ix,iy,c: Byte;
begin
 c:=Getcolor; SetColor(1);{или 8}
 for iy:=1 to n do for ix:=1 to n do
 Connect(ix,iy); SetColor(c);
end;

Procedure OutImage;
begin
 If OutGraph Then BGraph;
 If OutDist Then PutDist;
 PutPoints;
end;

Function BoolToStr(b: boolean): String;
begin If b Then BoolToStr:='true' else BoolToStr:='false' end;

Function CorDist(p1,p2: PointType): Boolean;
Var a,c: real; e1: LongInt; i,t,t1,e2,rs: Integer; r,res: Boolean;
begin
a:=(p2.x-p1.x)/(p1.y-p2.y+1E-3{Воизбежание деления на ноль});
c:=-a*p1.y-p1.x;
t:=0; t1:=0; rs:=1;
for i:=1 to n do begin
 e1:=Round(Points[i].x+a*Points[i].y+c){};
 If e1=0 Then Inc(t1);
 If e1>0 Then Inc(t);
 If e1<0 Then Dec(t);{}
end;
res:=(abs(t)+t1>=n);
CorDist:={true{}res{};
end;

Function GetCTI: Byte;
var i: Byte;
begin
 for i:=1 to n do If Central[i] Then begin
 GetCTI:=i; exit; end;
 GetCTI:=none;{все города вошли в тур}
end;

Procedure Insert(no,cn: Byte);
{no - номер вставляумого города;cn - позиция, куда нужно вставить номер города}
Var i: Byte; t: Integer;
begin
 for i:=n+1 downto cn+1 do Towns[i]:=Towns[i-1];
 Towns[cn]:=no
end;

Procedure BPolygon2;
{построение тура в виде выпуклого многоугольника, содержащего как можно
большее количество городов}
Var i,ii,cn,ot{нач.город},nt{след.город},pt{пред.город}: Byte;
begin
 for i:=2 to n do for ii:=1 to n do
 if (i<>ii) {and (ii<>pt){} and CorDist(Points[i],Points[ii]) Then begin
   ot:=i; pt:=i; nt:=ii; Towns[1]:=ii; cn:=1;
   Central[i]:=false; central[ii]:=false;{города не центральные}
   Connect(i,ii);{соединение вершин начального ребра}
   break;
 end;{нахождение начального ребра выпуклого многоугольника}
 repeat for i:=1 to n do
 If (CorDist(Points[nt],Points[i])) and (i<>pt) and (i<>nt) then begin
   inc(cn);  pt:=nt;  nt:=i;  Towns[cn]:=nt;
   Central[nt]:=false;  Connect(pt,nt);{}
 end;
 {поиск остальных ребёр}
 until nt=ot;
 {до тех пор, пока следующий город не совпадёт с начальным, т. е. получим
 замкнутый тур, в который надо будет включить центральные города}
 Towns[cn+1]:=Towns[1]; TIP:=cn;
 {Towns[n] - массив, содержащий номера городов по порядку, которые нужно
 посетить.}
end;

Procedure AddCTowns;
{Включение в тур центральных городов}
var i,ii,no,CTI,t,tk: Byte; min: Word; d: LongInt;
begin
 tk:=TIP;
 for t:=1 to n-tk{} do begin
   CTI:=GetCTI;
   min:=65535;{в начале любое число должно быть меньше min}
   for i:=1 to TIP{} do begin
     d:=Dist[Towns[i],CTI] + Dist[CTI,Towns[i+1]] - Dist[Towns[i],Towns[i+1]];
     {d - увеличение длины тура при вставке в него CTI-того города}
     If d<min then begin min:=d; no:=i; end;
   end;
   {Нашли оптимальную позицию для вставки города}
   SetColor(14);{} Disconnect(Towns[no],Towns[no+1]);
   Connect(Towns[no],CTI); Connect(CTI,Towns[no+1]);
   {Соединить соседние города со вставленным}
   Insert(CTI,no+1);
   {Вставить город в тур с минимальным увеличением длины тура}
   Central[CTI]:=false;{город больше не центральный}
   Inc(TIP);{Увеличить количество городов в туре}
 end;{Until GetCTownInd=none;{}
 {До тех пор пока не останется центральных городов}
end;

Procedure OutPutTour;
Var t,i,x: Byte;
begin
 For i:=1 to n+1 do Show(IntToStr(Towns[i])+'-');
 ShowLn('');
end;

begin
 d:=Detect; InitGraph(d,m,'');
 Repeat
   Init;{Инициализация данных}
   {MShow;{}
   SetPointCoord;
   {Установить случайные координаты городов в заданном пределе}
   FillDist;
   {Определить все расстояния между городами}
   OutImage;
   {Вывод на экран графа, номеров городов и расстояний между ними}
   BPolygon2;
   {Построить выпуклый многоугольник на основании построенного графа}
   OutPutTour;
   {Вывести на экран тур, состоящий из городов, лежащих на периметре постро-
   енного выпуклого многоугольника}
   AddCTowns;
   {Добавить в тур все ещё не пройденные города}
   OutPutTour; Show('...'+IntToStr(EstimateTour));
   {Вывести на экран конечный тур и его длину}
   OutTextXY(20,GetMaxY-9,Prop);
 Until Readkey<>#13;
 {Если нажат не Enter, то выйти}
 CloseGraph;
end.