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

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
uses windos,CRT;
Const n =3001;
Type arr=array[1..n] of integer;
Var a:arr;i:integer;h1,h2,m1,m2,s1,s2,hund1,hund2,diff : Word;
procedure printA(a:arr;c:integer);
begin
for i:=1 to 10 do write(a[i],' ');
writeln;
end;
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;
printA(a,0);
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;
printA(a,1);
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 x < a[j] 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 i<right then sort(i,right);
end;
begin
sort(1,n);
printA(a,2);
end;
Begin
clrscr;
for i:=1 to n do a[i]:=random(1000);
printA(a,4);
readkey;
gettime(h1, m1, s1, hund1);
StraightSelection(a);
gettime(h2, m2, s2, hund2);
writeln('Straight Selection');
writeln('start: ',s1,':',hund1);
writeln('finish: ',s2,':',hund2);
readkey;
gettime(h1, m1, s1, hund1);
BubbleSort(a);
gettime(h2, m2, s2, hund2);
writeln('Bubble Sort');
writeln('start: ',s1,':',hund1);
writeln('finish: ',s2,':',hund2);
readkey;
gettime(h1, m1, s1, hund1);
QuickSort(a);
gettime(h2, m2, s2, hund2);
writeln('Quick Sort');
writeln('start: ',s1,':',hund1);
writeln('finish: ',s2,':',hund2);
readkey;
End.