Сравнение алгоритм в сортировки

  Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, Grids;

const

  NN=25;

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)

    Label1: TLabel;

    Label4: TLabel;

    Label3: TLabel;

    Label6: TLabel;

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    N5: TMenuItem;

    N6: TMenuItem;

    N7: TMenuItem;

    N8: TMenuItem;

    OpenDialog1: TOpenDialog;

    SaveDialog1: TSaveDialog;

    StringGrid1: TStringGrid;

    ComboBox1: TComboBox;

    Button1: TButton;

    procedure ComboBox1Change(Sender: TObject);

    procedure N2Click(Sender: TObject);

    procedure N3Click(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure Button1Click(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);

 

    { 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

{$R *.dfm}

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

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

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(StringGrid1.Cells[i,j]);

      end;

    end;

  end;

end;

 

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

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

procedure TForm1.ComboBox1Change(Sender: TObject);

var

  i,j:byte;

begin

  N:=StrToInt(ComboBox1.Text);

  stringGrid1.ColCount:=N+1;

  stringGrid1.RowCount:=N+1;

    for j:=1 to N+1 do begin

      stringGrid1.Cells[0,j]:='A'+inttostr(j);

      stringGrid1.Cells[j,0]:='A'+inttostr(j);

      stringGrid1.Cells[j,j]:='0';

end;

 for j:=1 to N do stringGrid1.ColWidths[j]:=30;

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 TForm1.N2Click(Sender: TObject);

var

  FInput:Integer;

  i,j:byte;

  s,num:integer;

begin

  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));

      end;

  ComboBox1.ItemIndex:=num-2;

  ComboBox1Change(ComboBox1);

  FileClose(FInput);

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:='';

  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.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

      FileWrite(FOutput,s,SizeOf(s));

    end;

  FileClose(FOutput);

  ChangeFileExt(SaveDialog1.FileName,'.kom');

end;

 

procedure TForm1.N4Click(Sender: TObject);

begin

  Close;

end;

 

procedure TForm1.Button1Click(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];

{Определение множества  конкурирующих пар и выбор  перспективной пары}

  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;

{Удаление RGor'ой строки и MGor'ого столбца}

      DelStrStolb(RGor,MGor);

      IsklStrok[RGor]:=1;

      IsklStolb[MGor]:=1;