**[**Back to SORTING SWAG index**]** **[**Back to Main SWAG index**]** **[**Original**]**

*{
MARK OUELLET
> I code these things this way:
>
> for I := 1 to MAX-1 do
> for J := I+1 to MAX do
> if A[I] < A[J] then
> begin
> ( swap code )
> end
this can be improved even more. By limiting the MAX value on each
successive loop by keeping track of the highest swaped pair.
If on a particular loop, no swap is performed from element MAX-10
onto the end. Then the next loop does not need to go anyhigher than
MAX-11. Remember you are moving the highest value up, if no swap is
performed from MAX-10 on, it means all values above MAX-11 are in order
and all values below MAX-10 are smaller than MAX-10.
}
{$X+}
***program **MKOSort;
**USES
**Crt;
**Const
**MAX = 1000;
**var
**A : **Array**[1..MAX] **of **word;
Loops : word;
**procedure **Swap(**Var **A1, A2 : word);
**var
**Temp : word;
**begin
**Temp := A1;
A1 := A2;
A2 := Temp;
**end**;
**procedure **working;
**const
**cursor : **array**[0..3] **of **char = '\|/-';
CurrentCursor : byte = 1;
Update : word = 0;
**begin
**update := (update + 1) **mod **2500;
**if **update = 0 **then
begin
**DirectVideo := False;
write(Cursor[CurrentCursor], #13);
CurrentCursor := ((CurrentCursor + 1) **mod **4);
DirectVideo := true;
**end**;
**end**;
**procedure **Bubble;
**var
**Highest,
Limit, I : word;
NotSwaped : boolean;
**begin
**Limit := MAX;
Loops := 0;
**repeat
**I := 1;
Highest := 2;
NotSwaped := true;
**repeat
**working;
**if **A[I] > A[I + 1] **then
begin
**Highest := I;
NotSwaped := False;
Swap(A[I], A[I + 1]);
**end**;
Inc(I);
**until **(I = Limit);
Limit := Highest;
Inc(Loops);
**until **(NotSwaped) **or **(Limit <= 2);
**end**;
**procedure **InitArray;
**var
**I, J : word;
Temp : word;
**begin
**randomize;
**for **I := 1 **to **MAX **do
**A[I] := I;
**for **I := MAX - 1 **downto **1 **do
begin
**J := random(I) + 1;
Swap(A[I + 1], A[J]);
**end**;
**end**;
**procedure **Pause;
**begin
**writeln;
writeln('Press any key to continue...');
**while **keypressed **do
**readkey;
**while not **keypressed **do**;
readkey;
**end**;
**procedure **PrintOut;
**var
**I : word;
**begin
**ClrScr;
**For **I := 1 **to **MAX **do
begin
if **WhereY >= 22 **then
begin
**Pause;
ClrScr;
**end**;
**if **(WhereX >= 70) **then
**Writeln(A[I] : 5)
**else
**Write(A[I] : 5);
**end**;
writeln;
Pause;
**end**;
**begin
**ClrScr;
InitArray;
PrintOut;
Bubble;
PrintOut;
writeln;
writeln('Took ', Loops, ' Loops to complete');
**end**.

**[**Back to SORTING SWAG index**]** **[**Back to Main SWAG index**]** **[**Original**]**