157 lines
4.1 KiB
Plaintext
157 lines
4.1 KiB
Plaintext
unit Sorting;
|
||
{=============================================}
|
||
{ James L. Allison }
|
||
{ 1703 Neptune Lane }
|
||
{ Houston, Texas 77062 }
|
||
{ Dec 22, 1988 }
|
||
{=============================================}
|
||
|
||
{ Please feel free to use any part of this in any of your programs.}
|
||
|
||
interface
|
||
uses TypeSpec;
|
||
type
|
||
Item=TypeSpec.Character; {This defines the objects being sorted.}
|
||
List=array [0..0] of Item; {This is an array of objects to be sorted.}
|
||
|
||
L_Less_Than_R = function(L,R:Item):boolean;
|
||
{ This is a user defined function that determines the
|
||
order of the sort. It may be as simple or complex as
|
||
necessary to give the desired order. In particular it
|
||
can use any field in a record as the sort key, or use
|
||
more than one key. }
|
||
|
||
{ Make sure that range check is off before you use any of these. }
|
||
|
||
procedure QuickSort (var X:List; Less_Than:L_Less_Than_R; N:integer);
|
||
{ A very fast sort, uses recursion.
|
||
May have stack problems on a large sort. }
|
||
|
||
procedure ShellSort (var X:List; Less_Than:L_Less_Than_R; N:integer);
|
||
{ Almost as fast as QuickSort, but without recursion.
|
||
The work horse of fast sorting methods. }
|
||
|
||
procedure LoopSort (var X:List; Less_Than:L_Less_Than_R; N:integer);
|
||
{ No reason to use this. Included only for comparison. }
|
||
|
||
procedure BubbleSort (var X:List; Less_Than:L_Less_Than_R; N:integer);
|
||
{ The only time to use this is when the array is almost in order, with
|
||
only a couple of items out of place. It may be useful to modify this
|
||
to make the sweep from the other end of the array. BubbleSort is
|
||
a special purpose method. Stick to QuickSort or ShellSort.}
|
||
|
||
(*---------------------------------------------------------------------*)
|
||
implementation
|
||
(*---------------------------------------------------------------------*)
|
||
procedure Swap(var X:List;I,J:integer);
|
||
var
|
||
Temp:Item;
|
||
begin
|
||
Temp:=X[I];
|
||
X[I]:=X[J];
|
||
X[J]:=Temp;
|
||
end;
|
||
(*---------------------------------------------------------------------*)
|
||
procedure Qsort(var X:List;Less_Than:L_Less_Than_R;Left,Right:integer);
|
||
label
|
||
Again;
|
||
var
|
||
Pivot:Item;
|
||
P,Q:integer;
|
||
|
||
begin
|
||
P:=Left;
|
||
Q:=Right;
|
||
Pivot:=X [(Left+Right) div 2];
|
||
|
||
while P<=Q do
|
||
begin
|
||
while Less_Than(X[P],Pivot) do inc(P);
|
||
while Less_Than(Pivot,X[Q]) do dec(Q);
|
||
if P>Q then goto Again;
|
||
Swap(X,P,Q);
|
||
inc(P);dec(Q);
|
||
end;
|
||
|
||
Again:
|
||
if Left<Q then Qsort(X,Less_Than,Left,Q);
|
||
if P<Right then Qsort(X,Less_Than,P,Right);
|
||
end;
|
||
|
||
(*---------------------------------------------------------------------*)
|
||
procedure QuickSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
|
||
begin
|
||
Qsort(X,Less_Than,0,N-1);
|
||
end;
|
||
|
||
(*---------------------------------------------------------------------*)
|
||
procedure ShellSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
|
||
var
|
||
Gap,I,J:integer;
|
||
|
||
begin
|
||
Gap:=N div 2;
|
||
|
||
while Gap>0 do
|
||
begin
|
||
I:=Gap;
|
||
|
||
while I<N do
|
||
begin
|
||
J:=I-Gap;
|
||
|
||
while (J>=0) and (Less_Than(X[J+Gap],X[J])) do
|
||
begin
|
||
Swap(X,J,J+Gap);
|
||
dec(J,Gap);
|
||
end;
|
||
|
||
inc(I);
|
||
end;
|
||
|
||
Gap:=Gap div 2;
|
||
end;
|
||
|
||
end;
|
||
|
||
(*---------------------------------------------------------------------*)
|
||
procedure LoopSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
|
||
var
|
||
I,J:integer;
|
||
begin
|
||
for I:=0 to N-1 do
|
||
begin
|
||
for J:=I+1 to N-1 do
|
||
begin
|
||
if Less_Than(X[J],X[I])
|
||
then
|
||
begin
|
||
Swap(X,I,J);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
(*---------------------------------------------------------------------*)
|
||
procedure BubbleSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
|
||
var
|
||
J:integer;
|
||
Finished:boolean;
|
||
begin
|
||
repeat
|
||
Finished:=true;
|
||
for J:=0 to N-2 do
|
||
if Less_Than(X[J+1],X[J]) then
|
||
begin
|
||
Finished:=false;
|
||
Swap(X,J,J+1);
|
||
end;
|
||
dec(N);
|
||
until Finished;
|
||
end;
|
||
|
||
begin
|
||
end.
|
||
|
||
|
||
|