unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Menus;

const
  NN=10;

type
  Gorod=array[1..NN,1..NN] of integer;
  Dopolnit=array[1..NN] of integer;
  ConPrived=array[0..NN,0..2] of integer;
  Iskluch=array[1..NN] of byte;
  ItogPuti=array[1..NN*2] of integer;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    BitBtn1: TBitBtn;
    Label6: TLabel;
    Label7: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    Label13: TLabel;
    Label15: TLabel;
    Label18: TLabel;
    Label12: TLabel;
    Label19: TLabel;
    Label16: TLabel;
    Label110: TLabel;
    Label14: TLabel;
    Label17: TLabel;
    Label11: TLabel;
    Label23: TLabel;
    Label25: TLabel;
    Label28: TLabel;
    Label22: TLabel;
    Label29: TLabel;
    Label26: TLabel;
    Label210: TLabel;
    Label24: TLabel;
    Label27: TLabel;
    Label21: TLabel;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Edit15: TEdit;
    Edit16: TEdit;
    Edit17: TEdit;
    Edit18: TEdit;
    Edit19: TEdit;
    Edit110: TEdit;
    Edit21: TEdit;
    Edit22: TEdit;
    Edit23: TEdit;
    Edit24: TEdit;
    Edit25: TEdit;
    Edit26: TEdit;
    Edit27: TEdit;
    Edit28: TEdit;
    Edit29: TEdit;
    Edit210: TEdit;
    Edit31: TEdit;
    Edit32: TEdit;
    Edit33: TEdit;
    Edit34: TEdit;
    Edit35: TEdit;
    Edit36: TEdit;
    Edit37: TEdit;
    Edit38: TEdit;
    Edit39: TEdit;
    Edit310: TEdit;
    Edit41: TEdit;
    Edit42: TEdit;
    Edit43: TEdit;
    Edit44: TEdit;
    Edit45: TEdit;
    Edit46: TEdit;
    Edit47: TEdit;
    Edit48: TEdit;
    Edit49: TEdit;
    Edit410: TEdit;
    Edit51: TEdit;
    Edit52: TEdit;
    Edit53: TEdit;
    Edit54: TEdit;
    Edit55: TEdit;
    Edit56: TEdit;
    Edit57: TEdit;
    Edit58: TEdit;
    Edit59: TEdit;
    Edit510: TEdit;
    Edit61: TEdit;
    Edit62: TEdit;
    Edit63: TEdit;
    Edit64: TEdit;
    Edit65: TEdit;
    Edit66: TEdit;
    Edit67: TEdit;
    Edit68: TEdit;
    Edit69: TEdit;
    Edit610: TEdit;
    Edit71: TEdit;
    Edit72: TEdit;
    Edit73: TEdit;
    Edit74: TEdit;
    Edit75: TEdit;
    Edit76: TEdit;
    Edit77: TEdit;
    Edit78: TEdit;
    Edit79: TEdit;
    Edit710: TEdit;
    Edit81: TEdit;
    Edit82: TEdit;
    Edit83: TEdit;
    Edit84: TEdit;
    Edit85: TEdit;
    Edit86: TEdit;
    Edit87: TEdit;
    Edit88: TEdit;
    Edit89: TEdit;
    Edit810: TEdit;
    Edit91: TEdit;
    Edit92: TEdit;
    Edit93: TEdit;
    Edit94: TEdit;
    Edit95: TEdit;
    Edit96: TEdit;
    Edit97: TEdit;
    Edit98: TEdit;
    Edit99: TEdit;
    Edit910: TEdit;
    Edit101: TEdit;
    Edit102: TEdit;
    Edit103: TEdit;
    Edit104: TEdit;
    Edit105: TEdit;
    Edit106: TEdit;
    Edit107: TEdit;
    Edit108: TEdit;
    Edit109: TEdit;
    Edit1010: TEdit;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
   procedure BitBtn2Click(Sender: TObject);
   private
    procedure InputMatrix;
    procedure Etap(var GInd:integer);
    procedure Konkurir(var r,m:byte);
    procedure OpredilPuti;
    procedure Sbros;
    procedure DelStrStolb(Stroka,Stolb:byte);
    procedure Tree(K,XPos,YPos,Index,RG,MG,Blok,GIn:byte);
    function ObjEdit(S: string; IndexX: byte; IndexY: byte): TEdit;
    function ObjLabel(S: string; IndexX: byte): TLabel;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ParKonkur,GorodaIJ:Gorod;
  Ci,Cj:Dopolnit;
  GIndexKon:ConPrived;
  IsklStrok:Iskluch;
  IsklStolb:Iskluch;
  TreeList:TEdit;
  ListName:TLabel;
  Puti,NewPut:ItogPuti;
  N:byte;
  K:integer;

implementation

uses Unit2, Unit3;
{$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:=clNavy;
    if (XPos=0) and (YPos=0) then
    begin
      Font.Size:=7;
      Font.Color:=clBlue;
      Brush.Color:=clSilver;
      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:=clSilver;
      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 := clGray;
      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;
  for i:= 1 to NN*2 do
  begin
    Puti[i]:=0;
    NewPut[i]:=0;
  end;
  Label3.Caption:='';
  Image1.Picture.Bitmap.canvas.fillrect(canvas.cliprect) ;

  if N>6 then
  begin
    Image1.Width:=250+(N+1)*30;
    Image1.Height:=310+(N)*50;
    Image1.Picture.Bitmap.Width := Image1.Width;
    Image1.Picture.Bitmap.Height := Image1.Height;
    Form1.Height:=391+(N-6)*50;
    Form1.Width:=640+(N+1)*30;
  end
  else
  begin
    Image1.Width:=250;
    Image1.Height:=310;
    Form1.Height:=480;
    Form1.Width:=640;
  end;
end;

{****************************************************}
{Процедура нажатия кнопки начала}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i,RGor,MGor:byte;
  Flag:boolean;
begin
K:=-1;
{Получения количества городов}
  N:=StrToInt(ComboBox1.Text);
{Сброс всех значений на 0}
  Sbros;
  Flag:=true;
{Ввод матрицы длин путей между городами}
  InputMatrix;
{Предварительный этап. Определения исходного множества G0}
  Etap(GIndexKon[0,1]);
  GIndexKon[0,2]:=GIndexKon[0,1];
{Вывод G0 на экран в виде вершины дерева}
  Tree(0,0,0,0,0,0,0,GIndexKon[0,1]);
{Определение множества конкурирующих пар и выбор перспективной пары}
  Konkurir(RGor,MGor);
  Puti[1]:=RGor;
  Puti[2]:=MGor;
  GorodaIJ[RGor,MGor]:=-1;
{i-ые итерации.}
  for i:=1 to N-1 do
    if Flag then
    begin
{Определение множества G(i,2)}
      Etap(GIndexKon[i,2]);
      if GIndexKon[i-1,1]<GIndexKon[i-1,2] then
        GIndexKon[i,2]:=GIndexKon[i,2]+GIndexKon[i-1,1]
      else begin GIndexKon[i,2]:=GIndexKon[i,2]+GIndexKon[i-1,2];
        K:=K+1;
      End;
{Вывод подмножества G(i,2) на экран в виде листа дерева}
      Tree(K,2,i,i-1,RGor,MGor,1,GIndexKon[i,2]);
{Удаление RGor'ой строки и MGor'ого столбца}
      DelStrStolb(RGor,MGor);
      IsklStrok[RGor]:=1;
      IsklStolb[MGor]:=1;
{Вызов процедуры предотвращения образования коротких и длинных подциклов}
      ProverkaIskl;
{Определение множества G(i,1)}
      Etap(GIndexKon[i,1]);
      if GIndexKon[i-1,1]<GIndexKon[i-1,2] then
        GIndexKon[i,1]:=GIndexKon[i,1]+GIndexKon[i-1,1]
      else GIndexKon[i,1]:=GIndexKon[i,1]+GIndexKon[i-1,2];
      Label6.Caption:='Длина пути:  '+IntToStr(GIndexKon[i,1]);
{Вывод подмножества G(i,1) на экран в виде листа дерева}
      Tree(K,1,i,i-1,RGor,MGor,0,GIndexKon[i,1]);
{Определение множества конкурирующих пар и выбор перспективной пары}
      Konkurir(RGor,MGor);
      if ParKonkur[RGor,MGor]>=0 then
      begin
        Puti[i*2+1]:=RGor;
        Puti[i*2+2]:=MGor;
      end;
      if ParKonkur[RGor,MGor]<0 then Flag:=false;
      IsklStrok[RGor]:=1;
      IsklStolb[MGor]:=1;
      GorodaIJ[RGor,MGor]:=-1;
    end;
{Определение оптимального маршрута}
  OpredilPuti;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
  i,j:byte;
begin
  Sbros;
  for i:=1 to NN do
  begin
    ObjLabel('Label1',i).Visible:=False;
    ObjLabel('Label2',i).Visible:=False;
    for j:=1 to NN do
      ObjEdit('Edit',i,j).Visible:=False;
  end;
  N:=StrToInt(ComboBox1.Text);
  for i:=1 to N do
  begin
    ObjLabel('Label1',i).Visible:=True;
    ObjLabel('Label2',i).Visible:=True;
    for j:=1 to N do
      ObjEdit('Edit',i,j).Visible:=True;
  end;
 
end;

procedure TForm1.N2Click(Sender: TObject);
var
  FInput:Integer;
  i,j:byte;
  s,num:integer;
begin
  Sbros;
  OpenDialog1.InitialDir:=Application.ExeName;
  OpenDialog1.Filter:='Файл Коммивояжера (*.kom)|*.kom';
  if not OpenDialog1.Execute then exit;
  FInput:=FileOpen(OpenDialog1.FileName,fmOpenRead);
  FileRead(FInput,num,sizeof(num));
  for i:=1 to num do
    for j:=1 to num do
    if i<>j then
    begin
      FileRead(FInput,s,sizeof(s));
      ObjEdit('Edit',i,j).Text:=IntToStr(s);
    end;
  ComboBox1.ItemIndex:=num-2;
  ComboBox1Change(ComboBox1);
  FileClose(FInput);
end;

procedure TForm1.N3Click(Sender: TObject);
var
  FOutput:Integer;
  i,j:byte;
  s,num:integer;
begin
  SaveDialog1.InitialDir:=Application.ExeName;
  SaveDialog1.Filter:='Файл Коммивояжера(*.kom)|*.kom';
  if not SaveDialog1.Execute then exit;
  FOutput:=FileOpen(SaveDialog1.FileName,fmOpenWrite);
  if FOutput=-1 then
    FOutput:=FileCreate(ChangeFileExt(SaveDialog1.FileName,'.kom'));
  num:=StrToInt(ComboBox1.Text);
  FileWrite(FOutput,num,sizeof(num));
  for i:=1 to num do
    for j:=1 to num do
    if i<>j then
    begin
      s:=StrToInt(ObjEdit('Edit',i,j).Text);
      FileWrite(FOutput,s,SizeOf(s));
    end;
  FileClose(FOutput);
  ChangeFileExt(SaveDialog1.FileName,'.kom');
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  Close;
end;



procedure TForm1.N8Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
 Form3.Show;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var

  i,j:byte;
  num:integer;
begin
    for i:=1 to num do
    for j:=1 to num do
    if i<>j then
    begin
     ObjEdit('Edit',i,j).Text:='0';
    end;
  ComboBox1.ItemIndex:=num-2;
  ComboBox1Change(ComboBox1);
  Label6.Caption:='Длина пути: 0' ;
  Image1.Width:=250;
    Image1.Height:=310;
    Form1.Height:=480;
    Form1.Width:=640;
end;

end.
