uses windos CRT Const 7000 Type arr array of integer Var arr integer h

uses windos,CRT;
Const n =7000;
Type arr=array[1..n] of integer;
Var a:arr;i:integer;h1,h2,m1,m2,s1,s2,hund1,hund2,diff : Word;

procedure StraightSelection(a:arr);
var i,j,k,x:integer;
begin
     for i:=1 to n-1 do
     begin
          k:=i;
          x:=a[i];
          for j:=i+1 to n do
              if a[j]<x then
              begin
                   k:=j;
                   x:=a[j];
              end;
              a[k]:=a[i];
              a[i]:=x;
     end;
end;

procedure BubbleSort(a:arr);
var x,i,j:integer;
begin
     for i:=2 to n do
         for j:=n downto i do
             if a[j-1]>a[j] then
             begin
                  x:=a[j-1];
                  a[j-1]:=a[j];
                  a[j]:=x;
             end;
end;

procedure ShakerSort(a:arr);
var i,j,k,left,right,x:integer;
begin
     left:=2;
     right:=4;
     k:=n;
     repeat
           for j:=right downto left do
               if a[j-1]>a[j] then
               begin
                    x:=a[j-1];
                    a[j-1]:=a[j];
                    a[j]:=x;
                    k:=j;
               end;
           left:=k+1;
           for i:=left to right do
               if a[j-1]>a[j] then
               begin
                    x:=a[j-1];
                    a[j-1]:=a[j];
                    a[j]:=x;
                    k:=j;
               end;
           right:=k-1;
     until left>right;
end;

procedure QuickSort(a:arr);
     procedure sort(left,right:integer);
     var i,j,x,w:integer;
     begin
          i:=left;
          j:=right;
          x:=a[(left + right) div 2];

          repeat
                while a[i] < x do i:=i+1;
                while a[j]<x do j:=j-1;
                if i<=j then
                begin
                     w:=a[i];
                     a[i]:=a[j];
                     a[j]:=w;
                     i:=i+1;
                     j:=j-1;
                end;
          until i>j;
          if left<j then sort(left,j);
          if right>i then sort(i,right);
     end;

begin
     sort(1,n);
end;

procedure printA(a:arr);
var i:integer;
begin
     for i:=1 to n do writeln(a[i]);
end;

Begin
     clrscr;
     for i:=1 to n do a[i]:=random(30000);

     gettime(h1, m1, s1, hund1);
     StraightSelection(a);
     gettime(h2, m2, s2, hund2);
     if hund1>hund2 then writeln('Straight Selection Sort ',s2-s1,':',hund2+hund1)
     else writeln('Straight Selection Sort ',s2-s1,':',hund2-hund1);

     gettime(h1, m1, s1, hund1);
     QuickSort(a);
     gettime(h2, m2, s2, hund2);
     if hund1>hund2 then writeln('Quick Sort ',s2-s1,':',hund2+hund1)
     else writeln('Quick Sort ',s2-s1,':',hund2-hund1);

     gettime(h1, m1, s1, hund1);
     BubbleSort(a);
     gettime(h2, m2, s2, hund2);
     if hund1>hund2 then writeln('Bubble Sort ',s2-s1,':',hund2+hund1)
     else writeln('Bubble Sort ',s2-s1,':',hund2-hund1);

     gettime(h1, m1, s1, hund1);
     ShakerSort(a);
     gettime(h2, m2, s2, hund2);
     if hund1>hund2 then writeln('Shaker Sort ',s2-s1,':',hund2+hund1)
     else writeln('Shaker Sort ',s2-s1,':',hund2-hund1);

     readkey;
End.