Program Salesman_Problem;
{Meтoд вeтвeи и гpaниц}
Uses Crt;
Const 
 N=9;{} MaxDist=7; TC=14;{Цвет текста}
 None=MaxDist+2;{Оценка уже оцененного города}

Type TDist=Record
  Enable,goable: Boolean;
  Dist:          Integer;
end;

Var
Dist :array [0..n,0..n] of TDist;
Marks: array [0..n,0..n] of Integer;
Towns: array [0..n] of Byte;
Temp2: array [0..n+1] of Byte;
pgs:   LongInt;
I:     Integer;

Points: array[0..n] of Record
  x,y: Integer; end;
Cycled: array[0..n,0..n] of Boolean;

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 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].Dist:=Round(Sqrt(dx*dx+dy*dy));
end;
end;

Procedure ClearMarks;
var ix,iy: Integer;
begin
TextColor(7);
for iy:=1 to n do for ix:=1 to n do Marks[ix,iy]:=None;
end;

Procedure InitCycled;
var ix,iy: Integer;
begin
for iy:=1 to n do for ix:=1 to n do Cycled[ix,iy]:=true;
end;

Procedure Init;
begin
 Randomize;
 TextBackground(0);
 ClrScr;
 GotoXY(1,1);
 ClearMarks;
 InitCycled;
end;

Function HorMin(V,no: Byte): Integer;
var i,res: integer;
begin
res:=32000;
For i:=1 to n do
    If (Dist[i,V].Enable) and (Dist[i,V].Dist<res) and (i<>no) Then
    res:=Dist[i,V].Dist;
HorMin:=res;
end;

Function VerMin(H,no: Byte): Integer;
var i,res: integer;
begin
res:=32000;
For i:=1 to n do
    If (Dist[H,i].Enable) and (Dist[H,i].Dist<res) and (i<>no) Then
    res:=Dist[H,i].Dist;
VerMin:=res;
end;

Procedure SetMarks;
{Расставляет оценки каждого ребра графа}
var i,ix,iy: Integer;
begin
For iy:=1 to n do
For ix:=1 to n do
If (Dist[ix,iy].Enable) then Marks[ix,iy]:=
 HorMin(iy,ix)+VerMin(ix,iy)-Dist[ix,iy].Dist;
end;

Procedure OutputDist;
Var ix,iy: Integer;
begin
GotoXY(1,4);{}
For iY:=1 to n do begin
    For ix:=1 to n do begin
        If Not Dist[ix,iy].Enable Then {TextBackground(TC){}
        if Dist[ix,iy].goable Then TextBackground(1)
        Else TextBackground(TC);
        If Dist[ix,iy].Enable Then TextBackground(0);
        Write(Dist[ix,iy].Dist,' ');{}
    end;
    WriteLn;
end;
TextBackground(0);
end;

Function SummTour: Integer;
Var n,res: Integer;
begin
n:={Towns[1]{}1{};
Repeat
  res:=res+Dist[Towns[n],n].Dist;
  n:=Towns[n]
Until n=1;
SummTour:=res;
end;

Procedure OutPutTour;
Var n: Integer;
begin
n:={Towns[1]{}1{};
Repeat
  Write(n{Towns[n]{},'-');
  n:=Towns[n]
Until n=1;
WriteLn;
Write('Длина маршрута: ',SummTour);
end;

Procedure OutputMarks;
Var ix,iy: Integer;
begin
GotoXY(1,4);
For iY:=1 to n do begin
    For ix:=1 to n do
    Write(Marks[ix,iy],' ');{}
    WriteLn;
end;
TextBackground(0);
end;

Function GetMaxMarkX: Integer;
{определение максимальной оценки}
Var ix,iy,max,x: Integer;
begin
max:=-32000;
For iy:=1 to n do for ix:=1 to n do
if (Dist[ix,iy].Enable) and (marks[ix,iy]>max) and (ix<>iy) then begin
   max:=marks[ix,iy];
   x:=ix;
end;
GetMaxMarkX:=x;
end;

Function GetMaxMarkY: Integer;
{определение максимальной оценки}
Var ix,iy,max,y: Integer;
begin
max:=-32000;
For iy:=1 to n do for ix:=1 to n do
if (Dist[ix,iy].Enable) and (marks[ix,iy]>max) and (ix<>iy) then begin
   max:=marks[ix,iy];
   y:=iy;
end;
GetMaxMarkY:=y;
end;

Procedure DeleteCycle;
Var ix,iy: Integer;
begin
For iy:=1 to n do for ix:=1 to n do
If Cycled[ix,iy]=false Then begin
   Dist[ix,iy].Enable:=false;
   {Dist[ix,iy].Dist:=0;
   Dist[ix,iy].goable:=false;{}
end;
end;

Procedure Estimate;
Var x,y,i: Integer;
begin
  SetMarks; x:=GetMaxMarkX;       y:=GetMaxMarkY;
  for i:=1 to n do Dist[x,i].Enable:=False;
  for i:=1 to n do Dist[i,y].Enable:=False;
  Dist[y,x].Enable:=False; Dist[x,y].goable:=true;
  for i:=1 to n do Cycled[x,i]:=Cycled[y,i];
  Cycled[x,y]:=False;Towns[y]:=x;DeleteCycle;
end;

Procedure FindFinal;
var x,y,ix,iy,ind: Integer;
begin
Ind:=0;
for ix:=1 to n do for iy:=1 to n do
if Dist[ix,iy].Enable Then begin
inc(ind); x:=ix;   y:=iy; end;
If Ind=1 then begin Dist[x,y].goable:=True;
Towns[y]:=x;Dist[ix,iy].Enable:=False;end;
end;

Function Completed: Boolean;
Var i: Integer; Res: boolean;
begin
  res:=true;
  For i:=1 to n do res:=res and (Towns[i]<>0);
  Completed:=res;
end;

Begin
Init;
Writeln('Поиск оптимального маршрута среди ',n,' городов... Для нового по-');
Writeln('иска нажмите  Enter, чтобы выйти  нажмите дюбую другую клавишу ');
Writeln;

Repeat
ReadFromFile;
FillDist;

While Not Completed do begin
   Estimate;
   FindFinal;{}
   if keyPressed and (readkey=#27) Then  break;
   if Keypressed and (readkey<>#27) then begin
       For i:=1 to n do Write(Towns[i],'-');
       Write(#13);
       SetMarks;
       {OutPutMarks;{}
       OutPutDist;
   end;
   If N<22 then begin
      {OutPutMarks;{}
      OutPutDist;{}
   end;
end;{}

For i:=1 to n do Write(Towns[i],'-');{}
{WriteLn;
Write('Длина маршрута: ',SummTour);{}

{Repeat Until Keypressed;{}
Until Readkey<>#13{Enter}
end.