[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]
{ Updated SORTING.SWG on May 26, 1995 }
{
>I've been programming for a couple years now, but there are certain things
>that you seldom just figure out on your own. One of them is the multitude
>of standard sorting techniques. I did learn these, however, in a class I
>took last year in Turbo Pascal. Let's see, Bubble Sort, Selection Sort,
>Quick Sort.. I think that's what they were called. Anyway, if anyone
>has the time and desire I'd appreciate a quick run-down of each and if
>possible some source for using them on a linked list. I remember most of
>the code to do them on arrays, but I forget which are the most efficient
>for each type of data.
Here is a program that I was given to demonstrate 8 different types of sorts.
I don't claim to know how they work, but it does shed some light on what the
best type probably is. BTW, it can be modified to allow for a random number
of sort elements (up to maxint div 10 I believe).
ALLSORT.PAS: Demonstration of various sorting methods.
Released to the public domain by Wayel A. Al-Wohaibi.
ALLSORT.PAS was written in Turbo Pascal 3.0 (but compatible with
TP6.0) while taking a pascal course in 1988. It is provided as is,
to demonstrate how sorting algorithms work. Sorry, no documentation
(didn't imagine it would be worth releasing) but bugs are included
too!
ALLSORT simply shows you how elements are rearranged in each
iteration of each of the eight popular sorting methods.
}
program SORTINGMETHODS;
uses
Crt;
const
N = 14; (* NO. OF DATA TO BE SORTED *)
Digits = 3; (* DIGITAL SIZE OF THE DATA *)
Range = 1000; (* RANGE FOR THE RANDOM GENERATOR *)
type
ArrayType = array[1..N] of integer;
TwoDimension = array[0..9, 1..N] of integer; (* FOR RADIX SORT ONLY *)
var
Data : ArrayType;
D : integer;
(*--------------------------------------------------------------------*)
procedure GetSortMethod;
begin
clrscr;
writeln;
writeln(' CHOOSE: ');
writeln(' ');
writeln(' 1 FOR SELECT SORT ');
writeln(' 2 FOR INSERT SORT ');
writeln(' 3 FOR BUBBLE SORT ');
writeln(' 4 FOR SHAKE SORT ');
writeln(' 5 FOR HEAP SORT ');
writeln(' 6 FOR QUICK SORT ');
writeln(' 7 FOR SHELL SORT ');
writeln(' 8 FOR RADIX SORT ');
writeln(' 9 TO EXIT ALLSORT ');
writeln(' ');
writeln;
readln(D)
end;
procedure LoadList;
var
I : integer;
begin
for I := 1 to N do
Data[I] := random(Range)
end;
procedure ShowInput;
var
I : integer;
begin
clrscr;
write('INPUT :');
for I := 1 to N do
write(Data[I]:5);
writeln
end;
procedure ShowOutput;
var
I : integer;
begin
write('OUTPUT:');
for I := 1 to N do
write(Data[I]:5)
end;
procedure Swap(var X, Y : integer);
var
Temp : integer;
begin
Temp := X;
X := Y;
Y := Temp
end;
(*-------------------------- R A D I X S O R T ---------------------*)
function Hash(Number, H : integer) : integer;
begin
case H of
3 : Hash := Number mod 10;
2 : Hash := (Number mod 100) div 10;
1 : Hash := Number div 100
end
end;
procedure CleanArray(var TwoD : TwoDimension);
var
I, J : integer;
begin
for I := 0 to 9 do
for J := 1 to N do
TwoD[I, J] := 0
end;
procedure PlaceIt(var X : TwoDimension; Number, I : integer);
var
J : integer;
Empty : boolean;
begin
J := 1;
Empty := false;
repeat
if (X[I, J] > 0) then
J := J + 1
else
Empty := true;
until (Empty) or (J = N);
X[I, J] := Number
end;
procedure UnLoadIt(X : TwoDimension; var Passed : ArrayType);
var
I,
J,
K : integer;
begin
K := 1;
for I := 0 to 9 do
for J := 1 to N do
begin
if (X[I, J] > 0) then
begin
Passed[K] := X[I, J];
K := K + 1
end
end
end;
procedure RadixSort(var Pass : ArrayType; N : integer);
var
Temp : TwoDimension;
Element,
Key,
Digit,
I : integer;
begin
for Digit := Digits downto 1 do
begin
CleanArray(Temp);
for I := 1 to N do
begin
Element := Pass[I];
Key := Hash(Element, Digit);
PlaceIt(Temp, Element, Key)
end;
UnLoadIt(Temp, Pass);
ShowOutput;
readln
end
end;
(*-------------------------- H E A P S O R T -----------------------*)
procedure ReHeapDown(var HEAPData : ArrayType; Root, Bottom : integer);
var
HeapOk : boolean;
MaxChild : integer;
begin
HeapOk := false;
while (Root * 2 <= Bottom)
and not HeapOk do
begin
if (Root * 2 = Bottom) then
MaxChild := Root * 2
else
if (HEAPData[Root * 2] > HEAPData[Root * 2 + 1]) then
MaxChild := Root * 2
else
MaxChild := Root * 2 + 1;
if (HEAPData[Root] < HEAPData[MaxChild]) then
begin
Swap(HEAPData[Root], HEAPData[MaxChild]);
Root := MaxChild
end
else
HeapOk := true
end
end;
procedure HeapSort(var Data : ArrayType; NUMElementS : integer);
var
NodeIndex : integer;
begin
for NodeIndex := (NUMElementS div 2) downto 1 do
ReHeapDown(Data, NodeIndex, NUMElementS);
for NodeIndex := NUMElementS downto 2 do
begin
Swap(Data[1], Data[NodeIndex]);
ReHeapDown(Data, 1, NodeIndex - 1);
ShowOutput;
readln;
end
end;
(*-------------------------- I N S E R T S O R T -------------------*)
procedure StrInsert(var X : ArrayType; N : integer);
var
J,
K,
Y : integer;
Found : boolean;
begin
for J := 2 to N do
begin
Y := X[J];
K := J - 1;
Found := false;
while (K >= 1)
and (not Found) do
if (Y < X[K]) then
begin
X[K + 1] := X[K];
K := K - 1
end
else
Found := true;
X[K + 1] := Y;
ShowOutput;
readln
end
end;
(*-------------------------- S H E L L S O R T ---------------------*)
procedure ShellSort(var A : ArrayType; N : integer);
var
Done : boolean;
Jump,
I,
J : integer;
begin
Jump := N;
while (Jump > 1) do
begin
Jump := Jump div 2;
repeat
Done := true;
for J := 1 to (N - Jump) do
begin
I := J + Jump;
if (A[J] > A[I]) then
begin
Swap(A[J], A[I]);
Done := false
end;
end;
until Done;
ShowOutput;
readln
end
end;
(*-------------------------- B U B B L E S O R T -------------------*)
procedure BubbleSort(var X : ArrayType; N : integer);
var
I,
J : integer;
begin
for I := 2 to N do
begin
for J := N downto I do
if (X[J] < X[J - 1]) then
Swap(X[J - 1], X[J]);
ShowOutput;
readln
end
end;
(*-------------------------- S H A K E S O R T ---------------------*)
procedure ShakeSort(var X : ArrayType; N : integer);
var
L,
R,
K,
J : integer;
begin
L := 2;
R := N;
K := N;
repeat
for J := R downto L do
if (X[J] < X[J - 1]) then
begin
Swap(X[J], X[J - 1]);
K := J
end;
L := K + 1;
for J := L to R do
if (X[J] < X[J - 1]) then
begin
Swap(X[J], X[J - 1]);
K := J
end;
R := K - 1;
ShowOutput;
readln;
until L >= R
end;
(*-------------------------- Q W I C K S O R T ---------------------*)
procedure Partition(var A : ArrayType; First, Last : integer);
var
Right,
Left : integer;
V : integer;
begin
V := A[(First + Last) div 2];
Right := First;
Left := Last;
repeat
while (A[Right] < V) do
Right := Right + 1;
while (A[Left] > V) do
Left := Left - 1;
if (Right <= Left) then
begin
Swap(A[Right], A[Left]);
Right := Right + 1;
Left := Left - 1
end;
until Right > Left;
ShowOutput;
readln;
if (First < Left) then
Partition(A, First, Left);
if (Right < Last) then
Partition(A, Right, Last)
end;
procedure QuickSort(var List : ArrayType; N : integer);
var
First,
Last : integer;
begin
First := 1;
Last := N;
if (First < Last) then
Partition(List, First, Last)
end;
(*-------------------------- S E L E C T S O R T -------------------*)
procedure StrSelectSort(var X : ArrayType; N : integer);
var
I,
J,
K,
Y : integer;
begin
for I := 1 to N - 1 do
begin
K := I;
Y := X[I];
for J := (I + 1) to N do
if (X[J] < Y) then
begin
K := J;
Y := X[J]
end;
X[K] := X[J];
X[I] := Y;
ShowOutput;
readln
end
end;
(*--------------------------------------------------------------------*)
procedure Sort;
begin
case D of
1 : StrSelectSort(Data, N);
2 : StrInsert(Data, N);
3 : BubbleSort(Data, N);
4 : ShakeSort(Data, N);
5 : HeapSort(Data, N);
6 : QuickSort(Data, N);
7 : ShellSort(Data, N);
8 : RadixSort(Data, N);
else
writeln('BAD INPUT')
end
end;
(*-------------------------------------------------------------------*)
BEGIN
GetSortMethod;
while (D <> 9) do
begin
LoadList;
ShowInput;
Sort;
writeln('PRESS ENTER TO RETURN');
readln;
GetSortMethod
end
END.
[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]