home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / MAI / QKSORT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  3KB  |  97 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 391 of 412
  3. From : David Dahl                          1:272/38.0           14 May 93  04:12
  4. To   : All
  5. Subj : Quick Sort In Pascal
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hello!
  8.  
  9.         I seem to remember someone asking for a quick sort
  10. implementation in Turbo Pascal not too long ago.  Well, I was
  11. feeling kinda bored so I whipped this up:}
  12.  
  13.  
  14. {$M 32768, 0, 655360}
  15. Program QuickSort;
  16.  
  17. (* PUBLIC DOMAIN *)
  18.  
  19. Uses CRT;
  20.  
  21. Const   MaxArraySize = 3000;
  22.  
  23. Type    NumberArray  = Array[1..MaxArraySize] of Integer;
  24.  
  25. Procedure QuickSortArray (Var ArrayToSort  : NumberArray;
  26.                           NumberOfElements : Word        );
  27.     Procedure QuickAux (Var WorkArray      : NumberArray;
  28.                             HeadIn, TailIn : Word        );
  29.     Var Compare : Integer;
  30.         Head,
  31.         Tail    : Word;
  32.     Begin
  33.          Head := HeadIn;
  34.          Tail := TailIn;
  35.  
  36.          If Head < Tail Then
  37.          Begin
  38.             Compare := WorkArray[Head];
  39.  
  40.             While Head < Tail do
  41.             Begin
  42.                  While (WorkArray[Tail] > Compare) AND
  43.                        (Head < Tail) do
  44.                        Dec(Tail);
  45.  
  46.                  If Head < Tail Then
  47.                  Begin
  48.                       WorkArray[Head] := WorkArray[Tail];
  49.                       Inc(Head);
  50.                  End;
  51.  
  52.                  While (WorkArray[Head] < Compare) AND
  53.                        (Head < Tail) do
  54.                        Inc(Head);
  55.  
  56.                 If Head < Tail Then
  57.                 Begin
  58.                      WorkArray[Tail] := WorkArray[Head];
  59.                      Dec (Tail);
  60.                 End;
  61.  
  62.             End;
  63.  
  64.             WorkArray[Head] := Compare;
  65.  
  66.             QuickAux (WorkArray, HeadIn, (Head-1));
  67.             QuickAux (WorkArray, (Tail+1)  , TailIn);
  68.          End;
  69.     End;
  70. Begin
  71.      QuickAux (ArrayToSort, 1, NumberOfElements);
  72. End;
  73.  
  74. Var TestArray : NumberArray;
  75.     Count     : Word;
  76. Begin
  77.      ClrScr;
  78.  
  79.      For Count := 1 to MaxArraySize do
  80.          TestArray[Count] := 32768 - Random(65535);
  81.  
  82.      Writeln ('Before Sort:');
  83.      For Count := 1 to MaxArraySize do
  84.          Write (TestArray[Count]:8);
  85.  
  86.      Writeln;
  87.      Writeln ('Sorting... ');
  88.      QuickSortArray (TestArray, MaxArraySize);
  89.  
  90.      Writeln;
  91.      Writeln ('After Sort: ');
  92.      For Count := 1 to MaxArraySize do
  93.          Write (TestArray[Count]:8);
  94.  
  95.      Writeln;
  96.      Readln
  97. End.