Алгоритм сортування 5 способами мовою Pascal

   

  Алгоритм сортування 5 способами мовою Pascal

program sorting;

const maxcnt=5;

type vector=array[1..maxcnt] of real;

var cmpcnt,swpcnt: integer;

  trace: boolean;

{  Допоміжна процедура друкування масиву }

procedure writevector(n: integer; m: vector);

var i: integer;

begin

  writeln('це перший елемент відсортованого рядка' , m[1]:6:2);

  for i:=2 to n do

writeln('  це m[', i, '] -ий елемент відсортованого рядка ', m[i]:6:2);

  writeln;

end;

  { Допоміжна функція порівняння елементів }

Function   less(a, b: real): boolean;

begin

  cmpcnt:=cmpcnt+1;

  if trace then writeln('Порівняння', a:6:2, ' з ', b:6:2);

  less:=a<b;

end;

  { Допоміжна процедура – обмін елементів }

procedure swap(var a,b:real);

var c:real;

begin

  swpcnt:=swpcnt+1;

  c:=a; a:=b; b:=c

end;

   { Найпростіший алгоритм сортування  - "бульбашка" }

procedure bubble(n: integer; var m: vector);

var i,j:integer;

begin

  for i:=n-1 downto 1 do

    for j:=1 to i do

      if less(m[j+1],m[j]) then begin

         swap(m[j],m[j+1]);

         if trace then writevector(n,m)

      end;

end;

  { Метод мінімального елемента мінімізує кількість перестановок }

procedure minelement(n: integer; var m: vector);

var i,j,k:integer;

begin

  for i:=1 to n-1 do begin

  { Знаходимо мінімальний елемент  з тих, що залишилось … }

    k:=i;

    for j:=i+1 to n do

      if less(m[j],m[k]) then k:=j;

  { і ставимо його на місце }

    if i<>k then begin

      swap(m[i],m[k]);

      if trace then writevector(n,m)

    end;

  end;

end;

 

{Метод вставки зменшує кількість порівнянь до    n*log₂(n) }

procedure inserting(n: integer; var m: vector);

var i,a,b,c:integer;

  k: real;

begin

  for i:=2 to n do begin

    { У відсортованій частині  масиву шукаємо місце для чергового елемента}

    { метод ділення навпіл }

    a:=1; b:=i;

    k:=m[i];

    while a<b do begin

      c:=(a+b)div 2;

      if less(k,m[c]) then

         while b>c do begin

           m[b]:=m[b-1];

           b:=b-1

         end

      else a:=c+1

    end;

    m[a]:=k; swpcnt:=swpcnt+i-a;

    if trace then writevector(n,m);    end;  end;

  { Пірамідальне сортування – один з найефективніших алгоритмів }

procedure pyramidal(n: integer; var m: vector);

label 1,2;

var i,j,k,l: integer;

  v: real;

begin

  { Перший етап: побудова піраміди }

  if trace then writeln('Перший етап');

  for i:=2 to n do begin

    j:=i;

    repeat

      k:=j div 2;

      if less(m[k],m[j]) then swap(m[k],m[j])

      else goto 1;

      j:=k

    until j=1;

  1: if trace then writevector(n,m)

  end;

  { Тепер виконується умова m[i/2]>=m[i] для будь-якого  i>1 }

  { Другий етап: вилучаємо з піраміди вершину і переносимо в кінець масиву}

  if trace then writeln('Другий етап');

  for i:=n downto 2 do begin

    v:=m[1];

    j:=1;

    while 2*j<i do begin

      k:=2*j;

      if less(m[k],m[k+1]) then begin

         m[j]:=m[k+1];

         j:=k+1

      end else begin

         m[j]:=m[k];

         j:=k

      end;

      swpcnt:=swpcnt+1

    end;

    m[j]:=m[i];

    if 2*j>i then

      while j>1 do begin

         l:=j div 2;

         if less(m[j],m[l]) then goto 2;

         swap(m[l],m[j]);

         j:=l

    end;

    2: m[i]:=v; swpcnt:=swpcnt+1;

    if trace then writevector(n,m)

  end;

end;

  { Рекурсивний алгоритм швидкого сортування Хоора}

procedure hoor(a,b: integer; var m: vector);

var   i,j,c: integer;     k: real;

begin     if a<b then   begin      { Обираємо ключовий елемент }

    c:=(a+b) div 2;       k:=m[c];

    { ділимо масив на дві групи, порівнюючи з ключовим елементом }

    i:=a; j:=b;   

    repeat

      if (i=c) and (i<j) then begin swap(m[i],m[j]); c:=j end;

      if   not less(k,m[i])   then   i:=i+1

      else  begin

         swap(m[i],m[j]);         j:=j-1;

         if j=c then c:=i

      end

    until i>j;

    { Якщо друга група порожня – перносимо в неї ключовий елемент }

    If   i>b   then   i:=b;

    If   trace   then   writevector(b,m);

    {виконуємо сортування кожної частини}

    hoor(a,i-1,m);        hoor(i,b,m);     end;   end;

var

  n,i: integer;

  m: vector;

  ans: char;

begin

  repeat

    write('Введено розмір масиву(від 1 до ', maxcnt, '): ');

    maxcnt:=5+random(5)

  until (1<=n) and (n<=maxcnt);

  writeln('Введено масив випадкових чисел:');

  for i:=1 to n do

    m[i]:=2+random(159);

  readln;

  write('Показати процес роботи? (y/N) '); readln(ans);

  trace:=(ans='y')or(ans='Y');

  writeln('оберіть метод сортування:');

  writeln('1 - "Бульбашка"');

  writeln('2 – мінімальний елемент');

  writeln('3 – метод вставки');

  writeln('4 – пірамідальне сортування');

  writeln('5 – швидке сортування Хоора');

  cmpcnt:=0; swpcnt:=0;

  repeat

    readln(ans);

    case ans of

      '1': bubble(n,m);

      '2': minelement(n,m);

      '3': inserting(n,m);

      '4': pyramidal(n,m);

      '5': hoor(1,n,m);

    end;

  until (ans>='1') and (ans<='5');

  writeln('Всього виконано ', cmpcnt, ' порівнянь та ', swpcnt, ' перестановок');

  writeln(' Відсортований масив:');

  writevector(n,m)

end.