Методы сортировки

  mas=array[0..416600] of longint; 

//$VCLDESIGN+

var

  Form1: Form;

  TextLabel1: TextLabel;

  PaintBox1: PaintBox;

  Edit1: Edit;

  Button1: Button;

  RadioButton1: RadioButton;

  RadioButton2: RadioButton;

  RadioButton3: RadioButton;

  RadioButton4: RadioButton;

  Button2: Button;

  Button3: Button;

  Panel1: Panel;

//$VCLDESIGN-

  X1, X2, Y1, Y2, S, A: mas;

  N, i, j, dat: integer;

  ts: string; 
 
 
 

procedure InitControls;

begin

  Form1:= Form.Create(0,0,877,368);

  Form1.InitControl(True,False,alNone,crDefault,clBtnFace,'Форма1','');

  TextLabel1:= TextLabel.Create(Form1,8,8,152,13);

  TextLabel1.InitControl(True,True,alNone,crDefault,clBtnFace,'Количество прямоугольников','');

  PaintBox1:= PaintBox.Create(Form1,368,16,481,297);

  PaintBox1.InitControl(True,True,alNone,crDefault,0,'0','');

  Edit1:= Edit.Create(Form1,168,8,65,17);

  Edit1.InitControl(True,True,alNone,crDefault,clWindow,'','');

  Button1:= Button.Create(Form1,248,5,75,25);

  Button1.InitControl(True,True,alNone,crDefault,0,'Генерировать','');

  RadioButton1:= RadioButton.Create(Form1,8,32,150,17);

  RadioButton1.InitControl(True,True,alNone,crDefault,clBtnFace,'Сортировка Обменами','');

  RadioButton1.PopMenu:= nil;

  RadioButton2:= RadioButton.Create(Form1,8,48,150,17);

  RadioButton2.InitControl(True,True,alNone,crDefault,clBtnFace,'Сортировка Вставками','');

  RadioButton2.PopMenu:= nil;

  RadioButton3:= RadioButton.Create(Form1,8,64,169,17);

  RadioButton3.InitControl(True,True,alNone,crDefault,clBtnFace,'Сортировка методом Хоора','');

  RadioButton3.PopMenu:= nil;

  RadioButton4:= RadioButton.Create(Form1,8,80,233,17);

  RadioButton4.InitControl(True,True,alNone,crDefault,clBtnFace,'Сортировка методом Уильямса-Флойда','');

  RadioButton4.PopMenu:= nil;

  Button2:= Button.Create(Form1,8,104,153,81);

  Button2.InitControl(True,True,alNone,crDefault,0,'СОРТИРОВАТЬ','');

  Button3:= Button.Create(Form1,168,104,153,81);

  Button3.InitControl(True,True,alNone,crDefault,0,'ПОСТРОИТЬ','');

  Panel1:= Panel.Create(Form1,8,192,73,41);

  Panel1.InitControl(True,True,alNone,crDefault,clBtnFace,'','');

  RadioButton1.Checked:= True;

  Form1.Position:= poScreenCenter;

  Form1.Show;

end; 

procedure Rand;

begin

     for i:=1 to N do

     begin

          X1[i]:= random(480);

          X2[i]:= random(480);

          Y1[i]:= random(290);

          Y2[i]:= random(290); 

     end;

end; 

procedure Space;

begin

     for i:=1 to N do

     begin

          S[i]:=abs((X1[i]-X2[i])*(Y1[i]-Y2[i]))

     end;

end; 

procedure ExchangeSort( var A : mas );

var

  x : integer;

begin

  for i := N downto 2 do

  for j := 2 to i do

  if A[j] < A[j - 1] then

  begin

       x := A[j];

       A[j] := A[j - 1];

       A[j - 1] := x;

  end;

end; 

procedure InsertSort( var A : mas );

var

  i, k : Integer;

  x : integer;

begin

  { Вставляем  в уже отсортированную часть  элементы со 2 по max }

  for i := 2 to N do

  begin

       k := i;

       x := A[i];

       { Передвигаем на 1 позицию направо элементы,

       большие вставляемого элемента (он  записан в x) }

        while  (A[k - 1] > x) do

        begin

             A[k] := A[k - 1];

             k := k - 1;

        end;

        { Вставляем элемент в нужную  позицию }

        A[k] := x;

  end;

end; 

Procedure PiramidaSort(var A: mas);

Var t, k, i, Y: Integer;

Begin

   For i := 2 to N do { создание структуры бинарного  дерева-"пирамиды" }

   begin

      t := i;

        while t <> 1 do

        begin k := t div 2;

               If A[k] >= A[t] then t := 1

               else

               begin

                  Y:=A[k]; A[k]:=A[t]; A[t]:=Y;

                  t := k;

               end

        end

   end;

   For i := N-1 downto 1 do { сортировка массива-"пирамиды" }

   begin

     Y:=A[i+1]; A[i+1]:=A[1]; A[1]:=Y;

      t := 1;

      While t <> 0 do

      begin

         k := t+t;

         If k > i then t := 0

         else

         begin

            If k < i then If A[k+1] > A[k] then k := k+1;

            If A[t] >= A[k] then t := 0

            else

            begin

               Y:=A[k]; A[k]:=A[t]; A[t]:=Y;

               t := k

            end;

         end;

      end;

   end;

End; 

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

function Partition( var A : mas; l, r : Integer; x : integer ) : Integer;

  { Переставляем элементы массива так, чтобы слева от элемента,

  равного x, были  только элементы меньшие или  равные x,

  а справа - элементы, большие или равные x }

var

  i, j : Integer;

  t : integer;

begin

  i := l - 1;

  j := r + 1;

  repeat 

  { Пока элементы справа больше среднего }

  repeat

  j := j - 1;

  until x >= A[j]; 

  { Пока элементы слева меньше среднего }

  repeat

  i := i + 1;

  until A[i] >= x; 

  { Меняем левый и правый элементы и продолжаем дальше }

  if i < j then

  begin

  t := A[i];

  A[i] := A[j];

  A[j] := t;

  end;

  { Иначе - левый и правый встретились -

  разбиение  массива завершено } 

  until i >= j;

  Partition := j;

  end; 

  { Рекурсивная  процедура быстрой сортировки }

  procedure RecoursiveQuick( var A : mas; l, r : Integer );

  var

  m : Integer;

  begin

  if l < r then

  begin

  { В качестве  граничного элемента выбирается  средний

  элемент массива }

  m := Partition(A, l, r, A[(l + r) div 2]);

  RecoursiveQuick(A, l, m);

  RecoursiveQuick(A, m + 1, r);

  end;

end; 

  { Быстрая сортировка }

  procedure QuickSort( var A : mas );

  begin

  RecoursiveQuick(A, 1, N);

  end; 
 
 
 

procedure Generation;

begin

     val(edit1.text, N, i);

     rand;

     Space;

     for i:=1 to N do

      A[i]:=S[i];

end; 

procedure Exchange;

begin 

      for i:=1 to N do

             A[i]:=S[i];

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute;

             ExchangeSort(A);

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute-dat;

        str(dat,ts);

        panel1.caption:=ts+'мc';

end; 

procedure Insert;

begin 

      for i:=1 to N do

             A[i]:=S[i];

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute;

             InsertSort(A);

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute-dat;

        str(dat,ts);

        panel1.caption:=ts+'мc';

end; 

procedure Piramida;

begin 

      for i:=1 to N do

             A[i]:=S[i];

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute;

             PiramidaSort(A);

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute-dat;

        str(dat,ts);

        panel1.caption:=ts+'мc';

end; 

procedure Quick;

begin 

      for i:=1 to N do

             A[i]:=S[i];

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute;

             QuickSort(A);

             dat:=currentdatetime.milliseconds+1000*currentdatetime.second+60000*currentdatetime.minute-dat;

        str(dat,ts);

        panel1.caption:=ts+'мc';

end; 
 

procedure Sort;

begin

     if radiobutton1.checked=true then Exchange;

     if radiobutton2.checked=true then Insert;

     if radiobutton3.checked=true then Quick;

     if radiobutton4.checked=true then Piramida;

end; 

procedure Build;

begin

     for j:=N downto 1 do

     for i:=N downto 1 do

     if A[j]= S[i] then

     begin

     paintbox1.rectangle(X1[i],Y1[i],X2[i],Y2[i]);

     paintbox1.floodfill((X1[i]+X2[i]) div 2,(Y1[i]+Y2[i]) div 2,random(65000));

     end;

end; 
 
 

begin

  InitControls;

  button1.onclick:= Generation;

  button2.onclick:= Sort;

  button3.onclick:= Build;

end. 

Приложение 2. Вспомогательная  программа 

 uses utils;

const R= 50000;

type

  mas=array[0..416600] of longint;

var A:mas;

    i, j, k : integer;

    N, dat: longint; 

   

procedure Rand;

begin

  for i:=1 to N do

      A[i]:=random(R);

end; 

procedure ExchangeSort;

var