sortowanie

program p24112014;
uses
    DOS, crt;
const
    n = 100;
type
    TabInt = array [1..n] of integer;
var
    i : integer;
    tab : TabInt;
    godz, min, sek, sek100 : word;
    t1, t2 : LongInt;
    ExecuteTime : array[1..5] of integer;
    ExecuteTimeName : array[1..5] of string;

//*************************************************
// Fill the TabInt array with random elements
//*************************************************
procedure RandomElements( var t : TabInt );
var
    i : integer;
begin
    randomize;
    for i := 1 to n do
    begin
        t[i] := random(99)+1;
    end;
end;
//*************************************************
// Display the TabInt array
//*************************************************
procedure DisplayArray( t : TabInt );
var
    i : integer;
begin
    for i := 1 to n do
    begin
        write(t[i], ' ');
    end;
    writeln;
end;

//*************************************************
// Swap elements
//*************************************************
procedure swap( var a : integer; var b : integer );
var
    tmp : integer;
begin
    tmp := a;
    a := b;
    b := tmp;
end;

//*************************************************
// Selection Sort
//*************************************************
procedure SelectionSort( t : TabInt );
    var i, j, k : integer;
begin
    GetTime(godz,min,sek,sek100);
    t1 := sek100 + 100*sek + min*6000 + godz*360000;
    for i := 1 to n do
    begin
        k := i;
        for j := i+1 to n do
        begin
            if t[j] < t[k] then k := j;
        end;
        swap( t[k], t[i] );
    end;
    GetTime(godz,min,sek,sek100);
    t2 := sek100 + 100*sek + min*6000 + godz*360000;
    ExecuteTime[1] := t2 - t1;
end;

//*************************************************
// Insert Sort
//*************************************************
procedure InsertSort( t : TabInt );
var
    i, j, x : integer;
begin
    GetTime(godz,min,sek,sek100);
    t1 := sek100 + 100*sek + min*6000 + godz*360000;
    for j := n-1 downto 1 do
    begin
        x := t[j];
        i := j + 1;
        while ( i <= n ) and ( x > t[i] ) do
        begin
            t[i-1] := t[i];
            inc(i);
        end;
        t[i-1] := x;
    end;
    GetTime(godz,min,sek,sek100);
    t2 := sek100 + 100*sek + min*6000 + godz*360000;
    ExecuteTime[2] := t2 - t1;
end;

//*************************************************
// Bubble Sort
//*************************************************
procedure BubbleSort( t : TabInt );
var
    i, j : integer;
    p : boolean;
begin
    GetTime(godz,min,sek,sek100);
    t1 := sek100 + 100*sek + min*6000 + godz*360000;
    for i := 1 to n do
    begin
        p := true;
        for j := 1 to n-i do
        begin
            if t[j] > t[j+1] then
            begin
                swap( t[j], t[j+1] );
                p := false
            end;
        end;
        if ( p = true ) then break
    end;
    GetTime(godz,min,sek,sek100);
    t2 := sek100 + 100*sek + min*6000 + godz*360000;
    ExecuteTime[3] := t2 - t1;
end;

//*************************************************
// Heap Sort
//*************************************************
procedure HeapSort( var t : TabInt );
var
    i, j, k, l, tmp : integer;
begin
    GetTime(godz,min,sek,sek100);
    t1 := sek100 + 100*sek + min*6000 + godz*360000;
    for i := 2 to n do
    begin
        j := i;
        k := i div 2;
        tmp := t[i];
        while ( ( k > 0 ) and ( t[k] < tmp ) ) do
        begin
            t[j] := t[k];
            j := k;
            k := j div 2;
        end;
        t[j] := tmp;
    end;
    for i := n downto 2 do
    begin
        swap( t[1], t[i] );
        j := 1;
        k := 2;
        while ( k < i ) do
        begin
            if ( ( k+1 < i ) and ( t[k+1] > t[k] ) ) then
            begin
                l := k + 1;
            end else
            begin
                l := k;
            end;
            if ( t[l] <= t[j] ) then break;
            swap( t[j], t[l] );
            j := l;
            k := 2*j;
        end;
    end;
    GetTime(godz,min,sek,sek100);
    t2 := sek100 + 100*sek + min*6000 + godz*360000;
    ExecuteTime[4] := t2 - t1;
end;

//*************************************************
// Quick Sort
//*************************************************
procedure QuickSort( left : integer; right : integer; var t : TabInt );
var
    i, j, pivot : integer;
begin

    pivot := t[ (left + right) div 2 ];
    t[ (left + right) div 2 ] := t[right];
    j := left;

    for i := left to right - 1 do
    begin
        if t[i] < pivot then
        begin
            swap( t[i], t[j] );
            inc(j);
        end;
    end;
    t[right] := t[j];
    t[j] := pivot;

    if ( left < j-1 ) then
        QuickSort( left, j-1, t );
    if ( j+1 < right ) then
        QuickSort( j+1, right, t);

end;




//*************************************************
// Main Function
//*************************************************
begin
    RandomElements( tab );

    ExecuteTimeName[1] := 'SelectionSort';
    ExecuteTimeName[2] := 'InsertSort';
    ExecuteTimeName[3] := 'BubbleSort';
    ExecuteTimeName[4] := 'HeapSort';
    ExecuteTimeName[5] := 'QuickSort';

    SelectionSort( tab );
    InsertSort( tab );
    BubbleSort( tab );
    HeapSort( tab );

    GetTime(godz,min,sek,sek100);
    t1 := sek100 + 100*sek + min*6000 + godz*360000;

    QuickSort(1, n, tab);

    GetTime(godz,min,sek,sek100);
    t2 := sek100 + 100*sek + min*6000 + godz*360000;
    ExecuteTime[5] := t2 - t1;

    for i := 1 to 5 do
    begin
        write(ExecuteTimeName[i], ' : ', ExecuteTime[i]);
        writeln;
    end;
    readln;
end.