program trideni;

uses crt;

var podminka : char;
    i, hodnota : integer;
    tridenepole : array[0..100] of integer;

procedure Nacteni;
begin
  clrscr;
  randomize;
  write('Vloz hodnotu, udavajici, kolik cisel chces tridit: '); readln(hodnota);
  writeln('Cisla budou nahodne vygenerovana.');
  for i := 1 to hodnota do
  begin
    tridenepole[i] := random(250);
    write(tridenepole[i]:5);
  end;
  writeln;
  writeln('Stiskni ENTER ...');
  readln;
end;

procedure Vystup;
begin
  writeln('Takto jsou cisla setridena:');
  for i := 1 to hodnota do write(tridenepole[i]:5);
  writeln;
  writeln('Stiskni ENTER ...');
  readln;
end;

procedure InsertSort(var pole: array of integer; maximum: integer);
var i, j, pom : integer;

begin
  for i := 2 to maximum do
  begin
    pom := pole[i];
    pole[0] := pom;
    j := i - 1;
    while (pom < pole[j]) do
    begin
      pole[j+1] := pole[j];
      j := j - 1;
    end;
    pole[j+1] := pom;
  end;
end;

procedure BubbleSort(var pole: array of integer; maximum: integer);
var k, l, pom: integer;
begin
  for k := 1 to maximum do
  begin
    for l := 1 to maximum-1 do
    begin
      if (pole[l] > pole[l+1]) then
      begin
        pom := pole[l];
        pole[l] := pole[l+1];
        pole[l+1] := pom;
      end;
    end;
  end;
end;

procedure ShakerSort(var pole: array of integer; maximum: integer);
var j, s, m, k, pom : integer;
begin
  s := 2;
  m := maximum;
  k := maximum;
  repeat
    for j := m downto s do
      if (pole[j-1] > pole[j]) then
      begin
        pom := pole[j-1];
        pole[j-1] := pole[j];
        pole[j] := pom;
        k := j;
      end;
    s := k+1;
    for j := s to m do
      if (pole[j-1] > pole[j]) then
      begin
        pom := pole[j-1];
        pole[j-1] := pole[j];
        pole[j] := pom;
        k := j;
      end;
    m := k-1;
  until (s > m);
end;

procedure SelectSort(var pole: array of integer; maximum: integer);
var j, k, minimum : integer;
begin
  for i := 1 to maximum-1 do
  begin
    minimum := pole[i];
    k := i;
    for j := i+1 to maximum do
      if (minimum > pole[j]) then
      begin
        minimum := pole[j];
        k := j;
      end;
    pole[k] := pole[i];
    pole[i] := minimum;
  end;
end;

procedure QuickSort(var pole: array of integer; minimum, maximum: integer);

  procedure Sort(l, r: Integer);
  var j, k, pom : integer;
  begin
    i := l;
    j := r;
    k := pole[(l+r) DIV 2];
    repeat
      while pole[i] < k do i := i + 1;
      while k < pole[j] do j := j - 1;
      if i <= j then
      begin
        pom := pole[i];
        pole[i] := pole[j];
        pole[j] := pom;
        i := i + 1;
        j := j - 1;
      end;
    until i > j;
    if l < j then Sort(l, j);
    if i < r then Sort(i, r);
  end;

begin {QuickSort};
  Sort(minimum,maximum);
end;

procedure ShellSort(var pole: array of integer; maximum: integer);
var i, j, k, s, x: integer;
    m: 1..4;
    h: array[1..4]of integer;

    d : integer;
    konec : boolean;

begin
  d := (trunc(maximum div 2));
  repeat
    for j := d + 1 to maximum do
    begin
      x := pole[j];
      i := j - d;
      repeat
        konec := false;
        if (x >= pole[i]) then konec := true
        else begin
          pole[i+d] := pole[i];
          i := i - d;
        end;
      until (i <= 0) or konec;
      pole[i + d] := x;
    end;
  d := (trunc(d div 2));
  until (d < 1);
end;


procedure HeapSort(var pole: array of integer; maximum: integer);
 var l, r, pom: integer;

     Procedure Vytvorhaldu;
     Label 13;
     Var i, j:integer;
     Begin
       i := l;
       j := 2*i;
       Pom := pole[i];
       While j <= r do
       Begin
         If j < r then
           if pole[j] < pole[j+1] then j := j+1;
           if pom >= pole[j] then goto 13;
           pole[i] := pole[j];
           i := j;
           j := 2*i;
       End;
     13: pole[i] := pom;
     End;

 Begin
   l := (maximum div 2) + 1;
   r := maximum;
   While l > 1 do
   Begin
     l := l - 1;
     Vytvorhaldu;
   end;
   While r > 1 do
   Begin
     Pom := pole[1];
     Pole[1] := pole[r];
     Pole[r] := pom;
     r := r - 1;
     Vytvorhaldu;
   end; 
 end;


BEGIN
  repeat
    clrscr;
    gotoxy(21,6);  writeln('Program na demonstraci tridicich metod.');
    gotoxy(30,8);  writeln('David Padrta - IVT 1');
    gotoxy(28,12); writeln('InsertSort  -  zmackni 1');
    gotoxy(28,13); writeln('BubbleSort  -  zmackni 2');
    gotoxy(28,14); writeln('ShakerSort  -  zmackni 3');
    gotoxy(28,15); writeln('SelectSort  -  zmackni 4');
    gotoxy(28,16); writeln('QuickSort   -  zmackni 5');
    gotoxy(28,17); writeln('ShellSort   -  zmackni 6');
    gotoxy(28,18); writeln('HeapSort    -  zmackni 7');
    gotoxy(25,21); writeln('Ukonceni programu  -  zmackni 9');
    podminka := readkey;
    case podminka of
     '1': begin
            Nacteni;
            InsertSort(tridenepole,hodnota);
            Vystup;
          end;
     '2': begin
            Nacteni;
            BubbleSort(tridenepole,hodnota);
            Vystup;
          end;
     '3': begin
            Nacteni;
            ShakerSort(tridenepole,hodnota);
            Vystup;
          end;
     '4': begin
            Nacteni;
            SelectSort(tridenepole,hodnota);
            Vystup;
          end;
     '5': begin
            Nacteni;
            QuickSort(tridenepole,1,hodnota);
            Vystup;
          end;
     '6': begin
            Nacteni;
            ShellSort(tridenepole,hodnota);
            Vystup;
          end;
     '7': begin
            Nacteni;
            HeapSort(tridenepole,hodnota);
            Vystup;
          end;
    end;
  until (podminka = '9');
  clrscr;
  gotoxy(20,10); write('Uspesne jste ukoncil(a) tento program ...');
  delay(1000);
END.