Задача коммивояжера и её реализация

  K:integer; 

implementation

{$R *.dfm} 

{****************************************************}

{Функция обращение  к элементам Edit через их Name в  строковом режиме}

function TForm1.ObjEdit(S: string; IndexX: byte; IndexY: byte): TEdit;

begin

  Result:=Form1.FindComponent(S + IntToStr(IndexX) + IntToStr(IndexY)) as TEdit;

end; 

{****************************************************}

{Функция обращение  к элементам Label через их Name в  строковом режиме}

function TForm1.ObjLabel(S: string; IndexX: byte): TLabel;

begin

  Result:=Form1.FindComponent(S + IntToStr(IndexX)) as TLabel;

end; 

{****************************************************}

{Процедура чтения  матрицы из Edit`ов}

procedure TForm1.InputMatrix;

var

  i,j:integer;

begin

  for i:=1 to N do

  begin

    GorodaIJ[i,i]:=-1;

    for j:=1 to N do

    begin

      if i<>j then

      begin

        GorodaIJ[i,j]:=StrToInt(ObjEdit('Edit',i,j).Text);

      end;

    end;

  end;

end; 

{****************************************************}

{Процедура нахождения перспективной пары из множества конкурирующих пар}

procedure TForm1.Konkurir(var r,m:byte);

var

  i,j,l:byte;

  xmin,ymin,max:integer;

begin

  for i:=1 to N do

    for j:=1 to N do

      ParKonkur[i,j]:=-1;

{Определяем  множество конкурирующих пар городов и определяем для них оценку}

  for i:=1 to N do

    for j:=1 to N do

      if GorodaIJ[i,j]=0 then

      begin

        xmin:=9999; ymin:=9999;

        for l:=1 to N do

        begin

          if (GorodaIJ[i,l]<=xmin) and (GorodaIJ[i,l]<>-1) and (l<>j) then

            xmin:=GorodaIJ[i,l];

          if (GorodaIJ[l,j]<=ymin) and (GorodaIJ[l,j]<>-1) and (l<>i) then

            ymin:=GorodaIJ[l,j];

        end;

        if xmin=9999 then xmin:=0;

        if ymin=9999 then ymin:=0;

        ParKonkur[i,j]:=xmin+ymin;

      end;

{Находим перспективную  пару (r,m)}

  max:=-1;

  for i:=1 to N do

    for j:=1 to N do

      if ParKonkur[i,j]>max then

      begin

        max:=ParKonkur[i,j];

        r:=i; m:=j;

      end;

end; 

{***************************************************}

{Процедуры ПРИВЕДЕНИЯ  матрицы.

А также для  нахождения нижней оценки G}

procedure TForm1.Etap(var GInd:integer);

var

  i,j,min:integer;

begin

GInd:=0;

{Находим минимальный  элемент матрицы по строкам}

  for i:=1 to N do

  begin

    min:=-1;

    for j:=1 to N do

    begin

      if GorodaIJ[i,j]<>-1 then

      begin

        if min=-1 then min:=GorodaIJ[i,j];

        if GorodaIJ[i,j]<=min then

        begin

          min:=GorodaIJ[i,j];

        end;

      end;

    end;

    if min=-1 then min:=0;

    Cj[i]:=min;

  end;

{отнимаем минимальные  элементы из элементов соответствующих  строк}

  for i:=1 to N do

  begin

    for j:=1 to N do

    begin

      if GorodaIJ[i,j]<>-1 then

        GorodaIJ[i,j]:=GorodaIJ[i,j]-Cj[i];

    end;

  end;

{Находим минимальный элемент полученной матрицы по столбцам}

for j:=1 to N do

  begin

    min:=-1;

    for i:=1 to N do

    begin

      if GorodaIJ[i,j]<>-1 then

      begin

        if min=-1 then min:=GorodaIJ[i,j];

        if GorodaIJ[i,j]<=min then

        begin

          min:=GorodaIJ[i,j];

        end;

      end;

    end;

    if min=-1 then min:=0;

    Ci[j]:=min;

  end;

{отнимаем минимальные  элементы из элементов соответствующих  столбцов

и находим оптимальное  множество с оценкой}

  for i:=1 to N do

  begin

    GInd:=GInd+Cj[i]+Ci[i];

    for j:=1 to N do

    begin

      if GorodaIJ[i,j]<>-1 then

        GorodaIJ[i,j]:=GorodaIJ[i,j]-Ci[j];

    end;

  end;

end; 

{****************************************************}

{Процедура вычеркивания  из матрицы Stroka строки и Stolb столбца}

procedure TForm1.DelStrStolb(Stroka,Stolb:byte);

var

  i:byte;

begin

  if (Stroka<>0) and (Stolb<>0) then

    for i:=1 to N do

    begin

      GorodaIJ[Stroka,i]:=-1;

      GorodaIJ[i,Stolb]:=-1;

    end;

end; 

{****************************************************}

{Процедура нахождения  оптимального пути}

procedure TForm1.OpredilPuti;

var

  i,j,k,l:integer;

  Fl:boolean;

begin

{Поиск начального  элемента}

  for i:=1 to n do

  begin

    Fl:=False;

    for j:=1 to N do

      if Puti[i*2-1]=Puti[j*2] then Fl:=true;

    if not Fl then

    begin

      NewPut[1]:=Puti[i*2-1];

      NewPut[2]:=Puti[i*2];

    end;

  end;

{Составления  оптимального маршрута}

  for k:=1 to N+1 do

  begin

    for l:=1 to N+1 do

      if Puti[l*2-1]=Newput[k] then

      begin

        NewPut[k]:=Puti[l*2-1];

        NewPut[k+1]:=Puti[l*2];

      end;

    NewPut[N+1]:=newput[1];

  end;

{Вывод последовательности  городов на экран}

  for i:=1 to N do

    Label3.Caption:=Label3.Caption+'A'+inttostr(newPut[i])+'->';

  Label3.Caption:=Label3.Caption+'A'+inttostr(newPut[N+1]);

end; 

{****************************************************}

{Процедура проверки  на замкнутость пути}

procedure ProverkaIskl;

var

  i,j,Stroka,Stolbec,x,y:byte;

begin

  x:=0;

  y:=0;

  for i:=1 to N do

  begin

    Stroka:=0;

    Stolbec:=0;

    for j:=1 to N do

    begin

      if (GorodaIJ[i,j]=-1) and (IsklStrok[i]<>1) then

        if (IsklStolb[j]<>1) then Stroka:=1;

      if (GorodaIJ[j,i]=-1) and (IsklStolb[i]<>1) then

        if (IsklStrok[j]<>1) then Stolbec:=1;

    end;

    if (Stroka=0) and (IsklStrok[i]<>1) then

    begin

      x:=i;

      Stroka:=1;

    end;

    if (Stolbec=0) and (IsklStolb[i]<>1) then y:=i;

  end;

  if x<>0 then

    if y<>0 then GorodaIJ[x,y]:=-1;

end; 

{****************************************************}

{Процедура вывода  дерева ветления на экран}

procedure TForm1.Tree(K,XPos,YPos,Index,RG,MG,Blok,GIn:byte);

begin

  with Image1.Picture.Bitmap.Canvas do

  begin

    Font.Name:='Arial';

    Font.Style:=[fsBold];

    Pen.Width:=2;

    Pen.Color:=clMaroon;

    if (XPos=0) and (YPos=0) then

    begin

      Font.Size:=7;

      Font.Color:=clBlue;

      Brush.Color:=clYellow;

      Ellipse(N*30-15,10,15+N*30,40);

      TextOut(N*30-10,18,'G[0]');

      Brush.Color:=clWhite;

      Font.Color := clBlue;

      TextOut(N*30-27,18,IntToStr(GIn));

    end

    else begin

      Font.Size:=7;

      Font.Color:=clBlue;

      Brush.Color:=clYellow;

      Ellipse(XPos*50+N*30-30-YPos*30+K*60,10+YPos*50,XPos*50+N*30-60-YPos*30+K*60,40+YPos*50);

      TextOut(XPos*50+N*30-58-YPos*30+K*60,18+YPos*50,('G['+IntToStr(Index+1)+','+IntToStr(XPos)+']'));

      Brush.Color:=clWhite;

      Font.Color := clGreen;

      if Blok=1 then

        Font.Style:=[fsStrikeOut,fsBold]

      else Font.Style:=[fsBold];

        TextOut(XPos*55+N*30-60-YPos*30+K*60,YPos*50-8,'('+IntToStr(RG)+','+IntToStr(MG)+')');

      Font.Color := clBlue;

      Font.Style:=[fsBold];

      TextOut(XPos*94+N*30-115-YPos*30+K*60,YPos*50+18,IntToStr(GIn));

      Pen.Color:=clRed;

      MoveTo(XPos*50+N*30-45-YPos*30+K*60,10+YPos*50);

      LineTo(Index+N*30-(YPos-1)*30+K*60,38+(Index)*50);

    end;

end; 

end; 

{****************************************************}

{Процедура создания  главной формы}

procedure TForm1.FormCreate(Sender: TObject);

begin

  Image1.Picture.Bitmap:=nil;

  Image1.Picture.Bitmap := TBitmap.Create;

  Image1.Picture.Bitmap.Width := Image1.Width;

  Image1.Picture.Bitmap.Height := Image1.Height;

end; 

{****************************************************}

{Процедура сброса всех значений}

procedure TForm1.Sbros;

var

  i,j:integer;

begin

  K:=-1;

  for i:=1 to NN do

  begin

    Ci[i]:=0;

    Cj[i]:=0;

    IsklStrok[i]:=0;

    IsklStolb[i]:=0;

    for j:=1 to NN do

      GorodaIJ[i,j]:=0;

  end;

  for i:=0 to NN do

    for j:=0 to 2 do

      GIndexKon[i,j]:=0;