THREE SORTING ROUTINES
{ Purpose: to illustrate three classical sorting routines:
Bubble
Select
Shell
The program creates arrays of random integers and then sorts the
arrays by each of the three algorithms. }
Program Sorting_routines;
Uses
Crt;
Const
Maxlength = 100;
Outfilename = 'SORTED.OUT';
Type
List = Array [1..Maxlength] of Integer;
Var
Original, Bubble, Select, Shell: List;
Exchanges: Longint;
Outfile: Text;
{ === CREATE RANDOM ENTRY ARRAY ================================= }
Procedure Create_array(Var X: List;
N: Integer);
{ Purpose: fill an array X with random integers less than Max_value
N = number of entries to use in X; if N > Maxlength, then N is set
to Maxlength }
Const
Max_value = 1000;
Var
Index: Integer;
Begin
Randomize;
If N > Maxlength
Then N := Maxlength;
For Index := 1 to N Do
X[Index] := Random(Max_value);
End;
{ === PRINT ARRAY =============================================== }
Procedure Print_array(Var X: List;
N: Integer;
Var OutF: Text);
{ Purpose: print out array X to the outfile OutF.
N = Length of X }
Var
Index: Integer;
Begin
For Index := 1 to N do
Begin
Write(OutF, X[Index] :5);
If Index MOD 10 = 0
Then Writeln(OutF);
End;
End;
{ === BUBBLE SORT ARRAY ========================================= }
Procedure Bubble_Sort(Var X: List; Last: Integer; Var Ex: Longint);
Var
LCV, Temp: Integer;
Sorted: Boolean;
{ The "bubble-sort" works as follows: make several passes over the data;
on each pass, compare adjacent entries in the data. If a pair of data values
are out of order, switch them. On the first such pass, the largest value is
"bubbled" into the end of the array. On the next pass, the next largest value
is bubbled into the next-to-the-last position in the array. When a pass over
the data results in no more switches (which is signaled by Sorted never
becoming FALSE), the array is sorted, allowing "early exit" }
Begin
REPEAT
Sorted := True;
For LCV := 1 to Last - 1 Do
If X[LCV] > X[LCV + 1]
Then
Begin
Temp := X[LCV];
X[LCV] := X[LCV + 1];
X[LCV + 1] := Temp;
Sorted := False;
Ex := SUCC(Ex);
End;
Last := Last - 1
UNTIL Sorted;
End;
{ === SELECT SORT ARRAY ============================================= }
Procedure Select_sort(Var X: List; Last: Integer; Var Ex: Longint);
Var
Outerloop, Innerloop, Pointer, Temp: Integer;
Begin
For Outerloop := Last Downto 2 Do
Begin
Pointer := 1;
For Innerloop := 2 to Outerloop Do
If X[Pointer] < X[Innerloop]
Then Pointer := Innerloop;
If Outerloop <> Pointer Then
Begin
Temp := X[Outerloop];
X[Outerloop] := X[Pointer];
X[Pointer] := Temp;
Ex := SUCC(Ex);
End { IF }
End { FOR }
End; { Select Sort }
{ === SHELL SORT ARRAY ============================================== }
Procedure Shell_sort(Var X: List; Last: Integer; Var Ex: Longint);
Var
LCV, Gap, Temp: Integer;
Sorted: Boolean;
Begin
Gap := Last DIV 2;
While Gap <> 0 Do
Begin
REPEAT
Sorted := True;
For LCV := 1 to (Last - Gap) Do
If X[LCV] > X[LCV + Gap] Then
Begin
Temp := X[LCV];
X[LCV] := X[LCV + Gap];
X[LCV + Gap] := Temp;
Sorted := False;
Ex := SUCC(Ex);
End;
UNTIL Sorted;
Gap := Gap DIV 2
End; { WHILE }
End;
Begin
Clrscr;
Writeln('Arrays being sorted....');
Assign(Outfile, Outfilename);
Rewrite(Outfile);
Create_array(Original, Maxlength);
Writeln(Outfile, 'Original array: ');
Print_array(Original, Maxlength, Outfile);
Bubble := Original;
Exchanges := 0;
Bubble_sort(Bubble, Maxlength, Exchanges);
Writeln('Bubble sort completed...');
Writeln(Outfile);
Writeln(Outfile, 'Original array (Bubble sorted) with ', Exchanges, ' exchanges:');
Print_array(Bubble, Maxlength, Outfile);
Select := Original;
Exchanges := 0;
Select_sort(Select, Maxlength, Exchanges);
Writeln('Select sort completed...');
Writeln(Outfile);
Writeln(Outfile, 'Original array (Select sorted) with ', Exchanges, ' exchanges:');
Print_array(Select, Maxlength, Outfile);
Shell := Original;
Exchanges := 0;
Shell_sort(Shell, Maxlength, Exchanges);
Writeln('Shell sort completed...');
Writeln(Outfile);
Writeln(Outfile, 'Original array (Shell sorted) with ', Exchanges, ' exchanges:');
Print_array(Shell, Maxlength, Outfile);
Close(Outfile);
Writeln('Processing complete...');
Readln
End.
------------------------------------------
SCREEN OUTPUT
------------------------------------------
Arrays being sorted....
Bubble sort completed...
Select sort completed...
Shell sort completed...
Processing complete...
------------------------------------------
OUTPUT TO FILE SORTED.OUT
------------------------------------------
Original array:
358 441 649 632 330 333 182 157 774 331
406 217 650 888 633 351 259 345 491 69
752 155 489 861 72 283 440 514 502 632
52 242 243 620 221 352 691 248 837 439
333 286 130 336 446 423 879 307 998 503
2 220 453 191 349 681 371 694 729 364
997 386 476 21 255 448 96 906 810 890
795 606 133 549 930 492 732 943 692 304
978 69 552 573 188 518 276 895 893 519
557 262 472 754 554 960 549 72 892 753
Original array (Bubble sorted) with 2054 exchanges:
2 21 52 69 69 72 72 96 130 133
155 157 182 188 191 217 220 221 242 243
248 255 259 262 276 283 286 304 307 330
331 333 333 336 345 349 351 352 358 364
371 386 406 423 439 440 441 446 448 453
472 476 489 491 492 502 503 514 518 519
549 549 552 554 557 573 606 620 632 632
633 649 650 681 691 692 694 729 732 752
753 754 774 795 810 837 861 879 888 890
892 893 895 906 930 943 960 978 997 998
Original array (Select sorted) with 95 exchanges:
2 21 52 69 69 72 72 96 130 133
155 157 182 188 191 217 220 221 242 243
248 255 259 262 276 283 286 304 307 330
331 333 333 336 345 349 351 352 358 364
371 386 406 423 439 440 441 446 448 453
472 476 489 491 492 502 503 514 518 519
549 549 552 554 557 573 606 620 632 632
633 649 650 681 691 692 694 729 732 752
753 754 774 795 810 837 861 879 888 890
892 893 895 906 930 943 960 978 997 998
Original array (Shell sorted) with 452 exchanges:
2 21 52 69 69 72 72 96 130 133
155 157 182 188 191 217 220 221 242 243
248 255 259 262 276 283 286 304 307 330
331 333 333 336 345 349 351 352 358 364
371 386 406 423 439 440 441 446 448 453
472 476 489 491 492 502 503 514 518 519
549 549 552 554 557 573 606 620 632 632
633 649 650 681 691 692 694 729 732 752
753 754 774 795 810 837 861 879 888 890
892 893 895 906 930 943 960 978 997 998